Iteration on dterei's metadata design

- MetaArgs is not needed, as variables are already meta data

- Same goes for MetaVal - its only reason for existing seems to be to
  support LLVM's strange pretty-printing for meta-data annotations, and
  I feel that is better to keep the data structure clean and handle it in
  the pretty-printing instead.

- Rename "MetaData" to "MetaAnnot". Meta-data is still meta-data when it
  is not associated with an expression or statement - for example compile
  unit data for debugging. I feel the old name was a bit misleading.

- Make the renamed MetaAnnot a proper data type instead of a type alias
  for a pair.

- Rename "MetaExpr" constructor to "MetaStruct". As the data is much more
  like a LLVM structure (not array, as it can contain values).

- Fix a warning

compiler/llvmGen/Llvm.hs

@@ -25,7 +25,7 @@ module Llvm (
 
         -- * Call Handling
         LlvmCallConvention(..), LlvmCallType(..), LlvmParameterListType(..),
-        LlvmLinkageType(..), LlvmFuncAttr(..), MetaArgs(..),
+        LlvmLinkageType(..), LlvmFuncAttr(..),
 
         -- * Operations and Comparisons
         LlvmCmpOp(..), LlvmMachOp(..), LlvmCastOp(..),
@@ -38,7 +38,7 @@ module Llvm (
         i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
 
         -- ** Metadata types
-        MetaExpr(..), MetaVal(..), MetaData, MetaDecl(..),
+        MetaExpr(..), MetaAnnot(..), MetaDecl(..),
 
         -- ** Operations on the type system.
         isGlobal, getLitType, getLit, getName, getPlainName, getVarType,

compiler/llvmGen/Llvm/AbsSyn.hs

@@ -65,16 +65,6 @@ data LlvmFunction = LlvmFunction {
 
 type LlvmFunctions = [LlvmFunction]
 
--- | LLVM function call arguments.
-data MetaArgs
-    = ArgVar  LlvmVar  -- ^ Regular LLVM variable as argument.
-    | ArgMeta MetaExpr -- ^ Metadata as argument.
-    deriving (Eq)
-
-instance Show MetaArgs where
-  show (ArgVar  v) = show v
-  show (ArgMeta m) = show m
-
 -- | LLVM ordering types for synchronization purposes. (Introduced in LLVM
 -- 3.0). Please see the LLVM documentation for a better description.
 data LlvmSyncOrdering
@@ -176,9 +166,9 @@ data LlvmStatement
   {- |
     A LLVM statement with metadata attached to it.
   -}
-  | MetaStmt [MetaData] LlvmStatement
+  | MetaStmt [MetaAnnot] LlvmStatement
 
-  deriving (Show, Eq)
+  deriving (Eq)
 
 
 -- | Llvm Expressions
@@ -270,7 +260,7 @@ data LlvmExpression
       * attrs:     A list of function attributes for the call. Only NoReturn,
                    NoUnwind, ReadOnly and ReadNone are valid here.
   -}
-  | CallM LlvmCallType LlvmVar [MetaArgs] [LlvmFuncAttr]
+  | CallM LlvmCallType LlvmVar [MetaExpr] [LlvmFuncAttr]
 
   {- |
     Merge variables from different basic blocks which are predecessors of this
@@ -298,7 +288,7 @@ data LlvmExpression
   {- |
     A LLVM expression with metadata attached to it.
   -}
-  | MExpr [MetaData] LlvmExpression
+  | MExpr [MetaAnnot] LlvmExpression
 
-  deriving (Show, Eq)
+  deriving (Eq)
 

compiler/llvmGen/Llvm/MetaData.hs

@@ -58,34 +58,23 @@ import Llvm.Types
 
 import FastString
 
--- | LLVM metadata expressions ('metadata ...' form).
+-- | LLVM metadata expressions
 data MetaExpr = MetaStr LMString
               | MetaNode Int
               | MetaVar LlvmVar
-              | MetaExpr [MetaExpr]
+              | MetaStruct [MetaExpr]
               deriving (Eq)
 
--- | LLVM metadata nodes. See [Note: Metadata encoding].
-data MetaVal
-    -- | A literal expression as a metadata value ('!{ ..}' form).
-    = MetaValExpr MetaExpr
-    -- | A metadata node as a metadata value ('!10' form).
-    | MetaValNode Int
-    deriving (Eq)
-
 instance Show MetaExpr where
-  show (MetaStr  s ) = "metadata !\"" ++ unpackFS s ++ "\""
-  show (MetaNode n ) = "metadata !" ++ show n
-  show (MetaVar  v ) = show v
-  show (MetaExpr es) = intercalate ", " $ map show es
-
-instance Show MetaVal where
-  show (MetaValExpr  e) = "!{ " ++ show e ++ "}"
-  show (MetaValNode  n) = "!" ++ show n
+  show (MetaStr    s ) = "metadata !\"" ++ unpackFS s ++ "\""
+  show (MetaNode   n ) = "metadata !" ++ show n
+  show (MetaVar    v ) = show v
+  show (MetaStruct es) = "metadata !{ " ++ intercalate ", " (map show es) ++ "}"
 
--- | Associated some metadata with a specific label for attaching to an
+-- | Associates some metadata with a specific label for attaching to an
 -- instruction.
-type MetaData = (LMString, MetaVal)
+data MetaAnnot = MetaAnnot LMString MetaExpr
+               deriving (Eq)
 
 -- | Metadata declarations. Metadata can only be declared in global scope.
 data MetaDecl
@@ -95,33 +84,3 @@ data MetaDecl
     -- | Metadata node declaration.
     -- ('!0 = metadata !{ <metadata expression> }' form).
     | MetaUnamed Int MetaExpr
-
--- | LLVM function call arguments.
-data MetaArgs
-    = ArgVar  LlvmVar  -- ^ Regular LLVM variable as argument.
-    | ArgMeta MetaExpr -- ^ Metadata as argument.
-    deriving (Eq)
-
-instance Show MetaArgs where
-  show (ArgVar  v) = show v
-  show (ArgMeta m) = show m
-
-{-
-   Note: Metadata encoding
-   ~~~~~~~~~~~~~~~~~~~~~~~
-   The encoding use today has some redundancy in the form of 'MetaValNode'.
-   Instead of the current encoding where MetaExpr is an independent recursive
-   type, the encoding below could be used where MetaExpr and MetaVal are
-   co-recursive. The current encoding was chosen instead as it appears easier
-   to work with and cleaner to separate the two types.
-
-   -- metadata ...
-   data MetaExpr = MetaStr String
-                 | MetaVar LlvmVar
-                 | MetaVal [MetaVal]
-
-   -- !{ .. } | !10
-   data MetaVal = MetaExpr MetaExpr
-                | MetaNode Int
- -}
-

compiler/llvmGen/Llvm/PpLlvm.hs

@@ -108,11 +108,11 @@ ppLlvmMeta (MetaNamed n m)
 
 -- | Print out an LLVM metadata value.
 ppLlvmMetaExpr :: MetaExpr -> SDoc
-ppLlvmMetaExpr (MetaStr  s ) = text "metadata !" <> doubleQuotes (ftext s)
-ppLlvmMetaExpr (MetaNode n ) = text "metadata !" <> int n
-ppLlvmMetaExpr (MetaVar  v ) = texts v
-ppLlvmMetaExpr (MetaExpr es) =
-    hcat $ intersperse (text ", ") $ map ppLlvmMetaExpr es
+ppLlvmMetaExpr (MetaStr    s ) = text "metadata !" <> doubleQuotes (ftext s)
+ppLlvmMetaExpr (MetaNode   n ) = text "metadata !" <> int n
+ppLlvmMetaExpr (MetaVar    v ) = texts v
+ppLlvmMetaExpr (MetaStruct es) =
+    text "metadata !{" <> hsep (punctuate comma (map ppLlvmMetaExpr es)) <> char '}'
 
 
 -- | Print out a list of function definitions.
@@ -419,20 +419,21 @@ ppInsert vec elt idx =
     <+> texts idx
 
 
-ppMetaStatement :: [MetaData] -> LlvmStatement -> SDoc
-ppMetaStatement meta stmt = ppLlvmStatement stmt <> ppMetas meta
+ppMetaStatement :: [MetaAnnot] -> LlvmStatement -> SDoc
+ppMetaStatement meta stmt = ppLlvmStatement stmt <> ppMetaAnnots meta
 
-ppMetaExpr :: [MetaData] -> LlvmExpression -> SDoc
-ppMetaExpr meta expr = ppLlvmExpression expr <> ppMetas meta
+ppMetaExpr :: [MetaAnnot] -> LlvmExpression -> SDoc
+ppMetaExpr meta expr = ppLlvmExpression expr <> ppMetaAnnots meta
 
-ppMetas :: [MetaData] -> SDoc
-ppMetas meta = hcat $ map ppMeta meta
+ppMetaAnnots :: [MetaAnnot] -> SDoc
+ppMetaAnnots meta = hcat $ map ppMeta meta
   where
-    ppMeta (name, MetaValExpr e)
-        = comma <+> exclamation <> ftext name <+> text "!" <>
-            braces (ppLlvmMetaExpr e)
-    ppMeta (name, MetaValNode n)
-        = comma <+> exclamation <> ftext name <+> exclamation <> int n
+    ppMeta (MetaAnnot name e)
+        = comma <+> exclamation <> ftext name <+>
+          case e of
+            MetaNode n    -> exclamation <> int n
+            MetaStruct ms -> exclamation <> braces (ppCommaJoin ms)
+            other         -> exclamation <> braces (texts other) -- possible?
 
 
 --------------------------------------------------------------------------------

compiler/llvmGen/Llvm/Types.hs

@@ -324,6 +324,7 @@ llvmWidthInBits _      LMVoid          = 0
 llvmWidthInBits dflags (LMStruct tys)  = sum $ map (llvmWidthInBits dflags) tys
 llvmWidthInBits _      (LMFunction  _) = 0
 llvmWidthInBits dflags (LMAlias (_,t)) = llvmWidthInBits dflags t
+llvmWidthInBits _      LMMetadata      = panic "llvmWidthInBits: Meta-data has no runtime representation!"
 
 
 -- -----------------------------------------------------------------------------

compiler/llvmGen/LlvmCodeGen/CodeGen.hs

@@ -691,7 +691,7 @@ genStore_fast env addr r n val
 
 -- | CmmStore operation
 -- Generic case. Uses casts and pointer arithmetic if needed.
-genStore_slow :: LlvmEnv -> CmmExpr -> CmmExpr -> [MetaData] -> UniqSM StmtData
+genStore_slow :: LlvmEnv -> CmmExpr -> CmmExpr -> [MetaAnnot] -> UniqSM StmtData
 genStore_slow env addr val meta = do
     (env1, vaddr, stmts1, top1) <- exprToVar env addr
     (env2, vval,  stmts2, top2) <- exprToVar env1 val
@@ -1339,7 +1339,7 @@ genLoad_fast env e r n ty =
 
 -- | Handle Cmm load expression.
 -- Generic case. Uses casts and pointer arithmetic if needed.
-genLoad_slow :: LlvmEnv -> CmmExpr -> CmmType -> [MetaData] -> UniqSM ExprData
+genLoad_slow :: LlvmEnv -> CmmExpr -> CmmType -> [MetaAnnot] -> UniqSM ExprData
 genLoad_slow env e ty meta = do
     (env', iptr, stmts, tops) <- exprToVar env e
     case getVarType iptr of

compiler/llvmGen/LlvmCodeGen/Regs.hs

@@ -80,15 +80,15 @@ alwaysLive = [BaseReg, Sp, Hp, SpLim, HpLim, node]
 stgTBAA :: [MetaDecl]
 stgTBAA
   = [ MetaUnamed topN   $ MetaStr (fsLit "top")
-    , MetaUnamed stackN $ MetaExpr [MetaStr (fsLit "stack"), MetaNode topN]
-    , MetaUnamed heapN  $ MetaExpr [MetaStr (fsLit "heap"),  MetaNode topN]
-    , MetaUnamed rxN    $ MetaExpr [MetaStr (fsLit "rx"),    MetaNode heapN]
-    , MetaUnamed baseN  $ MetaExpr [MetaStr (fsLit "base"),  MetaNode topN]
+    , MetaUnamed stackN $ MetaStruct [MetaStr (fsLit "stack"), MetaNode topN]
+    , MetaUnamed heapN  $ MetaStruct [MetaStr (fsLit "heap"),  MetaNode topN]
+    , MetaUnamed rxN    $ MetaStruct [MetaStr (fsLit "rx"),    MetaNode heapN]
+    , MetaUnamed baseN  $ MetaStruct [MetaStr (fsLit "base"),  MetaNode topN]
     -- FIX: Not 100% sure about 'others' place. Might need to be under 'heap'.
     -- OR I think the big thing is Sp is never aliased, so might want
     -- to change the hieracy to have Sp on its own branch that is never
     -- aliased (e.g never use top as a TBAA node).
-    , MetaUnamed otherN $ MetaExpr [MetaStr (fsLit "other"), MetaNode topN]
+    , MetaUnamed otherN $ MetaStruct [MetaStr (fsLit "other"), MetaNode topN]
     ]
 
 -- | Id values
@@ -101,20 +101,20 @@ baseN  = 4
 otherN = 5
 
 -- | The various TBAA types
-top, heap, stack, rx, base, other :: MetaData
-top   = (tbaa, MetaValNode topN)
-heap  = (tbaa, MetaValNode heapN)
-stack = (tbaa, MetaValNode stackN)
-rx    = (tbaa, MetaValNode rxN)
-base  = (tbaa, MetaValNode baseN)
-other = (tbaa, MetaValNode otherN)
+top, heap, stack, rx, base, other :: MetaAnnot
+top   = MetaAnnot tbaa (MetaNode topN)
+heap  = MetaAnnot tbaa (MetaNode heapN)
+stack = MetaAnnot tbaa (MetaNode stackN)
+rx    = MetaAnnot tbaa (MetaNode rxN)
+base  = MetaAnnot tbaa (MetaNode baseN)
+other = MetaAnnot tbaa (MetaNode otherN)
 
 -- | The TBAA metadata identifier
 tbaa :: LMString
 tbaa = fsLit "tbaa"
 
 -- | Get the correct TBAA metadata information for this register type
-getTBAA :: GlobalReg -> MetaData
+getTBAA :: GlobalReg -> MetaAnnot
 getTBAA BaseReg          = base
 getTBAA Sp               = stack
 getTBAA Hp               = heap