[PATCH] llvmGen: Introduce infrastructure for module flag metadata

Gbp-Pq: Name 0003-llvmGen-Introduce-infrastructure-for-module-flag-metadata.patch

diff --git a/compiler/GHC/Llvm.hs b/compiler/GHC/Llvm.hs
index 5226c59db59c2396efe169ea98c345ad9131e5bc..c628ad673d34980ed1dc74599be206d319f5e3e7 100644 (file)
--- a/compiler/GHC/Llvm.hs
+++ b/compiler/GHC/Llvm.hs
@@ -42,6 +42,10 @@ module GHC.Llvm (
 
         -- ** Metadata types
         MetaExpr(..), MetaAnnot(..), MetaDecl(..), MetaId(..),
+        -- *** Module flags
+        ModuleFlagBehavior(..),
+        ModuleFlag(..),
+        moduleFlagToMetaExpr,
 
         -- ** Operations on the type system.
         isGlobal, getLitType, getVarType,

diff --git a/compiler/GHC/Llvm/MetaData.hs b/compiler/GHC/Llvm/MetaData.hs
index 4279eeccd8021438bbfa6e698a42f5817af4d072..2b28be4829f996f3c90f2ed6a6b8fb8dde576f41 100644 (file)
--- a/compiler/GHC/Llvm/MetaData.hs
+++ b/compiler/GHC/Llvm/MetaData.hs
@@ -6,6 +6,10 @@ module GHC.Llvm.MetaData
   , MetaExpr(..)
   , MetaAnnot(..)
   , MetaDecl(..)
+    -- * Module flags
+  , ModuleFlagBehavior(..)
+  , ModuleFlag(..)
+  , moduleFlagToMetaExpr
   ) where
 
 import GHC.Prelude
@@ -93,3 +97,42 @@ data MetaDecl
     -- | Metadata node declaration.
     -- ('!0 = metadata !{ \<metadata expression> }' form).
     | MetaUnnamed !MetaId !MetaExpr
+
+----------------------------------------------------------------
+-- Module flags
+----------------------------------------------------------------
+data ModuleFlagBehavior
+  = MFBError
+  | MFBWarning
+  | MFBRequire
+  | MFBOverride
+  | MFBAppend
+  | MFBAppendUnique
+  | MFBMax
+  | MFBMin
+
+moduleFlagBehaviorToMetaExpr :: ModuleFlagBehavior -> MetaExpr
+moduleFlagBehaviorToMetaExpr mfb =
+    MetaLit $ LMIntLit n i32
+  where
+    n = case mfb of
+      MFBError -> 1
+      MFBWarning -> 2
+      MFBRequire -> 3
+      MFBOverride -> 4
+      MFBAppend -> 5
+      MFBAppendUnique -> 6
+      MFBMax -> 7
+      MFBMin -> 8
+
+data ModuleFlag = ModuleFlag { mfBehavior :: ModuleFlagBehavior
+                             , mfName :: LMString
+                             , mfValue :: MetaExpr
+                             }
+
+moduleFlagToMetaExpr :: ModuleFlag -> MetaExpr
+moduleFlagToMetaExpr flag = MetaStruct
+    [ moduleFlagBehaviorToMetaExpr (mfBehavior flag)
+    , MetaStr (mfName flag)
+    , mfValue flag
+    ]