From: Ben Gamari <ben@smart-cactus.org>
Date: Tue, 22 Aug 2023 17:26:46 +0000 (-0400)
Subject: [PATCH] llvmGen: Introduce infrastructure for module flag metadata
X-Git-Tag: archive/raspbian/9.6.6-4+rpi1^2~2
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=89a7976b5afa4bc7491317c4dfbbc0f720023630;p=ghc.git

[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 5226c59d..c628ad67 100644
--- 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 4279eecc..2b28be48 100644
--- 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
+    ]