DynFlags refactoring VIII (#17957)

* Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.*

* Add LlvmOpts datatype to store Llvm backend options

* Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and
  Llvm.MetaExpr) which require LlvmOpts.

* Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`)

10 files changed, 356 insertions, 322 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index eaf73b475b..8d85c5aed0 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -1169,11 +1169,11 @@ instance Outputable CLabel where
 
 pprCLabel :: DynFlags -> CLabel -> SDoc
 pprCLabel dflags = \case
-   (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u
+   (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 
    (AsmTempLabel u)
       | not (platformUnregisterised platform)
-      -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u
+      -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 
    (AsmTempDerivedLabel l suf)
       | useNCG
@@ -1231,8 +1231,8 @@ pprCLabel dflags = \case
 pprCLbl :: DynFlags -> CLabel -> SDoc
 pprCLbl dflags = \case
    (StringLitLabel u)   -> pprUniqueAlways u <> text "_str"
-   (SRTLabel u)         -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt"
-   (LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore
+   (SRTLabel u)         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
+   (LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform
                            <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm"
                            -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7')
                            -- until that gets resolved we'll just force them to start
@@ -1242,7 +1242,7 @@ pprCLbl dflags = \case
    (CmmLabel _ str CmmData)     -> ftext str
    (CmmLabel _ str CmmPrimCall) -> ftext str
 
-   (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u
+   (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u
 
    (RtsLabel (RtsApFast str)) -> ftext str <> text "_fast"
 
@@ -1290,7 +1290,7 @@ pprCLbl dflags = \case
 
    (ForeignLabel str _ _ _) -> ftext str
 
-   (IdLabel name _cafs flavor) -> internalNamePrefix name <> ppr name <> ppIdFlavor flavor
+   (IdLabel name _cafs flavor) -> internalNamePrefix platform name <> ppr name <> ppIdFlavor flavor
 
    (CC_Label cc)       -> ppr cc
    (CCS_Label ccs)     -> ppr ccs
@@ -1301,6 +1301,8 @@ pprCLbl dflags = \case
    (DynamicLinkerLabel {})  -> panic "pprCLbl DynamicLinkerLabel"
    (PicBaseLabel {})        -> panic "pprCLbl PicBaseLabel"
    (DeadStripPreventer {})  -> panic "pprCLbl DeadStripPreventer"
+  where
+   platform = targetPlatform dflags
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <> text
@@ -1331,21 +1333,20 @@ instance Outputable ForeignLabelSource where
         ForeignLabelInThisPackage       -> parens $ text "this package"
         ForeignLabelInExternalPackage   -> parens $ text "external package"
 
-internalNamePrefix :: Name -> SDoc
-internalNamePrefix name = getPprStyle $ \ sty ->
+internalNamePrefix :: Platform -> Name -> SDoc
+internalNamePrefix platform name = getPprStyle $ \ sty ->
   if asmStyle sty && isRandomGenerated then
-    sdocWithDynFlags $ \dflags ->
-      ptext (asmTempLabelPrefix (targetPlatform dflags))
+      ptext (asmTempLabelPrefix platform)
   else
     empty
   where
     isRandomGenerated = not $ isExternalName name
 
-tempLabelPrefixOrUnderscore :: SDoc
-tempLabelPrefixOrUnderscore = sdocWithDynFlags $ \dflags ->
+tempLabelPrefixOrUnderscore :: Platform -> SDoc
+tempLabelPrefixOrUnderscore platform =
   getPprStyle $ \ sty ->
    if asmStyle sty then
-      ptext (asmTempLabelPrefix (targetPlatform dflags))
+      ptext (asmTempLabelPrefix platform)
    else
       char '_'
 
diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs
index f91f3578e6..ac8e9718e4 100644
--- a/compiler/GHC/CmmToLlvm.hs
+++ b/compiler/GHC/CmmToLlvm.hs
@@ -92,7 +92,8 @@ llvmCodeGen' dflags cmm_stream
         a <- Stream.consume cmm_stream llvmGroupLlvmGens
 
         -- Declare aliases for forward references
-        renderLlvm . pprLlvmData =<< generateExternDecls
+        opts <- getLlvmOpts
+        renderLlvm . pprLlvmData opts =<< generateExternDecls
 
         -- Postamble
         cmmUsedLlvmGens
@@ -150,14 +151,15 @@ cmmDataLlvmGens statics
        mapM_ regGlobal gs
        gss' <- mapM aliasify $ gs
 
-       renderLlvm $ pprLlvmData (concat gss', concat tss)
+       opts <- getLlvmOpts
+       renderLlvm $ pprLlvmData opts (concat gss', concat tss)
 
 -- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
 cmmLlvmGen ::RawCmmDecl -> LlvmM ()
 cmmLlvmGen cmm@CmmProc{} = do
 
     -- rewrite assignments to global regs
-    dflags <- getDynFlag id
+    dflags <- getDynFlags
     let fixed_cmm = {-# SCC "llvm_fix_regs" #-} fixStgRegisters dflags cmm
 
     dumpIfSetLlvm Opt_D_dump_opt_cmm "Optimised Cmm"
@@ -194,7 +196,8 @@ cmmMetaLlvmPrelude = do
               -- just a name on its own. Previously `null` was accepted as the
               -- name.
               Nothing -> [ MetaStr name ]
-  renderLlvm $ ppLlvmMetas metas
+  opts <- getLlvmOpts
+  renderLlvm $ ppLlvmMetas opts metas
 
 -- -----------------------------------------------------------------------------
 -- | Marks variables as used where necessary
@@ -217,6 +220,7 @@ cmmUsedLlvmGens = do
       sectName  = Just $ fsLit "llvm.metadata"
       lmUsedVar = LMGlobalVar (fsLit "llvm.used") ty Appending sectName Nothing Constant
       lmUsed    = LMGlobal lmUsedVar (Just usedArray)
+  opts <- getLlvmOpts
   if null ivars
      then return ()
-     else renderLlvm $ pprLlvmData ([lmUsed], [])
+     else renderLlvm $ pprLlvmData opts ([lmUsed], [])
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index 105254cfcc..38b9b8e582 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -21,9 +21,9 @@ module GHC.CmmToLlvm.Base (
         LlvmM,
         runLlvm, liftStream, withClearVars, varLookup, varInsert,
         markStackReg, checkStackReg,
-        funLookup, funInsert, getLlvmVer, getDynFlags, getDynFlag, getLlvmPlatform,
+        funLookup, funInsert, getLlvmVer, getDynFlags,
         dumpIfSetLlvm, renderLlvm, markUsedVar, getUsedVars,
-        ghcInternalFunctions, getPlatform,
+        ghcInternalFunctions, getPlatform, getLlvmOpts,
 
         getMetaUniqueId,
         setUniqMeta, getUniqMeta,
@@ -114,10 +114,10 @@ widthToLlvmInt :: Width -> LlvmType
 widthToLlvmInt w = LMInt $ widthInBits w
 
 -- | GHC Call Convention for LLVM
-llvmGhcCC :: DynFlags -> LlvmCallConvention
-llvmGhcCC dflags
- | platformUnregisterised (targetPlatform dflags) = CC_Ccc
- | otherwise                                      = CC_Ghc
+llvmGhcCC :: Platform -> LlvmCallConvention
+llvmGhcCC platform
+ | platformUnregisterised platform = CC_Ccc
+ | otherwise                       = CC_Ghc
 
 -- | Llvm Function type for Cmm function
 llvmFunTy :: LiveGlobalRegs -> LlvmM LlvmType
@@ -133,9 +133,8 @@ llvmFunSig' :: LiveGlobalRegs -> LMString -> LlvmLinkageType -> LlvmM LlvmFuncti
 llvmFunSig' live lbl link
   = do let toParams x | isPointer x = (x, [NoAlias, NoCapture])
                       | otherwise   = (x, [])
-       dflags <- getDynFlags
        platform <- getPlatform
-       return $ LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs
+       return $ LlvmFunctionDecl lbl link (llvmGhcCC platform) LMVoid FixedArgs
                                  (map (toParams . getVarType) (llvmFunArgs platform live))
                                  (llvmFunAlign platform)
 
@@ -148,10 +147,10 @@ llvmInfAlign :: Platform -> LMAlign
 llvmInfAlign platform = Just (platformWordSizeInBytes platform)
 
 -- | Section to use for a function
-llvmFunSection :: DynFlags -> LMString -> LMSection
-llvmFunSection dflags lbl
-    | gopt Opt_SplitSections dflags = Just (concatFS [fsLit ".text.", lbl])
-    | otherwise                     = Nothing
+llvmFunSection :: LlvmOpts -> LMString -> LMSection
+llvmFunSection opts lbl
+    | llvmOptsSplitSections opts = Just (concatFS [fsLit ".text.", lbl])
+    | otherwise                  = Nothing
 
 -- | A Function's arguments
 llvmFunArgs :: Platform -> LiveGlobalRegs -> [LlvmVar]
@@ -311,6 +310,7 @@ llvmVersionList = NE.toList . llvmVersionNE
 
 data LlvmEnv = LlvmEnv
   { envVersion :: LlvmVersion      -- ^ LLVM version
+  , envOpts    :: LlvmOpts         -- ^ LLVM backend options
   , envDynFlags :: DynFlags        -- ^ Dynamic flags
   , envOutput :: BufHandle         -- ^ Output buffer
   , envMask :: !Char               -- ^ Mask for creating unique values
@@ -342,8 +342,13 @@ instance Monad LlvmM where
 instance HasDynFlags LlvmM where
     getDynFlags = LlvmM $ \env -> return (envDynFlags env, env)
 
+-- | Get target platform
 getPlatform :: LlvmM Platform
-getPlatform = targetPlatform <$> getDynFlags
+getPlatform = llvmOptsPlatform <$> getLlvmOpts
+
+-- | Get LLVM options
+getLlvmOpts :: LlvmM LlvmOpts
+getLlvmOpts = LlvmM $ \env -> return (envOpts env, env)
 
 instance MonadUnique LlvmM where
     getUniqueSupplyM = do
@@ -370,6 +375,7 @@ runLlvm dflags ver out m = do
                       , envUsedVars = []
                       , envAliases = emptyUniqSet
                       , envVersion = ver
+                      , envOpts = initLlvmOpts dflags
                       , envDynFlags = dflags
                       , envOutput = out
                       , envMask = 'n'
@@ -426,14 +432,6 @@ getMetaUniqueId = LlvmM $ \env ->
 getLlvmVer :: LlvmM LlvmVersion
 getLlvmVer = getEnv envVersion
 
--- | Get the platform we are generating code for
-getDynFlag :: (DynFlags -> a) -> LlvmM a
-getDynFlag f = getEnv (f . envDynFlags)
-
--- | Get the platform we are generating code for
-getLlvmPlatform :: LlvmM Platform
-getLlvmPlatform = getDynFlag targetPlatform
-
 -- | Dumps the document if the corresponding flag has been set by the user
 dumpIfSetLlvm :: DumpFlag -> String -> DumpFormat -> Outp.SDoc -> LlvmM ()
 dumpIfSetLlvm flag hdr fmt doc = do
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index e106a5e111..672fc84e43 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -178,7 +178,7 @@ barrier = do
 --   exceptions (where no code will be emitted instead).
 barrierUnless :: [Arch] -> LlvmM StmtData
 barrierUnless exs = do
-    platform <- getLlvmPlatform
+    platform <- getPlatform
     if platformArch platform `elem` exs
         then return (nilOL, [])
         else barrier
@@ -415,7 +415,7 @@ genCall target res args = do
                         ++ " 0 or 1, given " ++ show (length t) ++ "."
 
     -- extract Cmm call convention, and translate to LLVM call convention
-    platform <- lift $ getLlvmPlatform
+    platform <- lift $ getPlatform
     let lmconv = case target of
             ForeignTarget _ (ForeignConvention conv _ _ _) ->
               case conv of
@@ -993,6 +993,7 @@ genStore_slow addr val meta = do
     let stmts = stmts1 `appOL` stmts2
     dflags <- getDynFlags
     platform <- getPlatform
+    opts <- getLlvmOpts
     case getVarType vaddr of
         -- sometimes we need to cast an int to a pointer before storing
         LMPointer ty@(LMPointer _) | getVarType vval == llvmWord platform -> do
@@ -1015,7 +1016,7 @@ genStore_slow addr val meta = do
                     (PprCmm.pprExpr platform addr <+> text (
                         "Size of Ptr: " ++ show (llvmPtrBits platform) ++
                         ", Size of var: " ++ show (llvmWidthInBits platform other) ++
-                        ", Var: " ++ showSDoc dflags (ppr vaddr)))
+                        ", Var: " ++ showSDoc dflags (ppVar opts vaddr)))
 
 
 -- | Unconditional branch
@@ -1041,7 +1042,8 @@ genCondBranch cond idT idF likely = do
             return (stmts1 `appOL` stmts2 `snocOL` s1, top1 ++ top2)
         else do
             dflags <- getDynFlags
-            panic $ "genCondBranch: Cond expr not bool! (" ++ showSDoc dflags (ppr vc) ++ ")"
+            opts <- getLlvmOpts
+            panic $ "genCondBranch: Cond expr not bool! (" ++ showSDoc dflags (ppVar opts vc) ++ ")"
 
 
 -- | Generate call to llvm.expect.x intrinsic. Assigning result to a new var.
@@ -1663,6 +1665,7 @@ genLoad_slow :: Atomic -> CmmExpr -> CmmType -> [MetaAnnot] -> LlvmM ExprData
 genLoad_slow atomic e ty meta = do
   platform <- getPlatform
   dflags <- getDynFlags
+  opts <- getLlvmOpts
   runExprData $ do
     iptr <- exprToVarW e
     case getVarType iptr of
@@ -1678,7 +1681,7 @@ genLoad_slow atomic e ty meta = do
                         (PprCmm.pprExpr platform e <+> text (
                             "Size of Ptr: " ++ show (llvmPtrBits platform) ++
                             ", Size of var: " ++ show (llvmWidthInBits platform other) ++
-                            ", Var: " ++ showSDoc dflags (ppr iptr)))
+                            ", Var: " ++ showSDoc dflags (ppVar opts iptr)))
   where
     loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr
                   | otherwise = Load ptr
@@ -1873,7 +1876,7 @@ funEpilogue live = do
         loadUndef r = do
           let ty = (pLower . getVarType $ lmGlobalRegVar platform r)
           return (Just $ LMLitVar $ LMUndefLit ty, nilOL)
-    platform <- getDynFlag targetPlatform
+    platform <- getPlatform
     let allRegs = activeStgRegs platform
     loads <- flip mapM allRegs $ \r -> case () of
       _ | (False, r) `elem` livePadded
diff --git a/compiler/GHC/CmmToLlvm/Data.hs b/compiler/GHC/CmmToLlvm/Data.hs
index b32f619640..ac155179d1 100644
--- a/compiler/GHC/CmmToLlvm/Data.hs
+++ b/compiler/GHC/CmmToLlvm/Data.hs
@@ -17,7 +17,6 @@ import GHC.CmmToLlvm.Base
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Cmm
-import GHC.Driver.Session
 import GHC.Platform
 
 import GHC.Data.FastString
@@ -71,7 +70,7 @@ genLlvmData (sec, CmmStaticsRaw lbl xs) = do
     label <- strCLabel_llvm lbl
     static <- mapM genData xs
     lmsec <- llvmSection sec
-    platform <- getLlvmPlatform
+    platform <- getPlatform
     let types   = map getStatType static
 
         strucTy = LMStruct types
@@ -113,9 +112,9 @@ llvmSectionType p t = case t of
 -- | Format a Cmm Section into a LLVM section name
 llvmSection :: Section -> LlvmM LMSection
 llvmSection (Section t suffix) = do
-  dflags <- getDynFlags
-  let splitSect = gopt Opt_SplitSections dflags
-      platform  = targetPlatform dflags
+  opts <- getLlvmOpts
+  let splitSect = llvmOptsSplitSections opts
+      platform  = llvmOptsPlatform opts
   if not splitSect
   then return Nothing
   else do
diff --git a/compiler/GHC/CmmToLlvm/Ppr.hs b/compiler/GHC/CmmToLlvm/Ppr.hs
index 290234d48a..49374a9869 100644
--- a/compiler/GHC/CmmToLlvm/Ppr.hs
+++ b/compiler/GHC/CmmToLlvm/Ppr.hs
@@ -27,21 +27,22 @@ import GHC.Types.Unique
 --
 
 -- | Pretty print LLVM data code
-pprLlvmData :: LlvmData -> SDoc
-pprLlvmData (globals, types) =
+pprLlvmData :: LlvmOpts -> LlvmData -> SDoc
+pprLlvmData opts (globals, types) =
     let ppLlvmTys (LMAlias    a) = ppLlvmAlias a
         ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
         ppLlvmTys _other         = empty
 
         types'   = vcat $ map ppLlvmTys types
-        globals' = ppLlvmGlobals globals
+        globals' = ppLlvmGlobals opts globals
     in types' $+$ globals'
 
 
 -- | Pretty print LLVM code
 pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
-pprLlvmCmmDecl (CmmData _ lmdata)
-  = return (vcat $ map pprLlvmData lmdata, [])
+pprLlvmCmmDecl (CmmData _ lmdata) = do
+  opts <- getLlvmOpts
+  return (vcat $ map (pprLlvmData opts) lmdata, [])
 
 pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
   = do let lbl = case mb_info of
@@ -55,10 +56,11 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
 
        funDec <- llvmFunSig live lbl link
        dflags <- getDynFlags
+       opts <- getLlvmOpts
        platform <- getPlatform
-       let buildArg = fsLit . showSDoc dflags . ppPlainName
+       let buildArg = fsLit . showSDoc dflags . ppPlainName opts
            funArgs = map buildArg (llvmFunArgs platform live)
-           funSect = llvmFunSection dflags (decName funDec)
+           funSect = llvmFunSection opts (decName funDec)
 
        -- generate the info table
        prefix <- case mb_info of
@@ -92,7 +94,7 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
                             (Just $ LMBitc (LMStaticPointer defVar)
                                            i8Ptr)
 
-       return (ppLlvmGlobal alias $+$ ppLlvmFunction platform fun', [])
+       return (ppLlvmGlobal opts alias $+$ ppLlvmFunction opts fun', [])
 
 
 -- | The section we are putting info tables and their entry code into, should
diff --git a/compiler/GHC/Llvm.hs b/compiler/GHC/Llvm.hs
index 65389a7a5b..64aba78c3a 100644
--- a/compiler/GHC/Llvm.hs
+++ b/compiler/GHC/Llvm.hs
@@ -10,6 +10,8 @@
 --
 
 module GHC.Llvm (
+        LlvmOpts (..),
+        initLlvmOpts,
 
         -- * Modules, Functions and Blocks
         LlvmModule(..),
@@ -50,7 +52,7 @@ module GHC.Llvm (
         pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits,
 
         -- * Pretty Printing
-        ppLit, ppName, ppPlainName,
+        ppVar, ppLit, ppTypeLit, ppName, ppPlainName,
         ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals,
         ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions,
         ppLlvmFunction, ppLlvmAlias, ppLlvmAliases, ppLlvmMetas, ppLlvmMeta,
diff --git a/compiler/GHC/Llvm/MetaData.hs b/compiler/GHC/Llvm/MetaData.hs
index c2a1aa4a8f..b485d94dbe 100644
--- a/compiler/GHC/Llvm/MetaData.hs
+++ b/compiler/GHC/Llvm/MetaData.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
 
 module GHC.Llvm.MetaData where
 
@@ -73,13 +74,6 @@ data MetaExpr = MetaStr !LMString
               | MetaStruct [MetaExpr]
               deriving (Eq)
 
-instance Outputable MetaExpr where
-  ppr (MetaVar (LMLitVar (LMNullLit _))) = text "null"
-  ppr (MetaStr    s ) = char '!' <> doubleQuotes (ftext s)
-  ppr (MetaNode   n ) = ppr n
-  ppr (MetaVar    v ) = ppr v
-  ppr (MetaStruct es) = char '!' <> braces (ppCommaJoin es)
-
 -- | Associates some metadata with a specific label for attaching to an
 -- instruction.
 data MetaAnnot = MetaAnnot LMString MetaExpr
diff --git a/compiler/GHC/Llvm/Ppr.hs b/compiler/GHC/Llvm/Ppr.hs
index c16f6b4136..283a2993d6 100644
--- a/compiler/GHC/Llvm/Ppr.hs
+++ b/compiler/GHC/Llvm/Ppr.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 
 --------------------------------------------------------------------------------
 -- | Pretty print LLVM IR Code.
@@ -21,6 +22,12 @@ module GHC.Llvm.Ppr (
     ppLlvmFunctions,
     ppLlvmFunction,
 
+    ppVar,
+    ppLit,
+    ppTypeLit,
+    ppName,
+    ppPlainName
+
     ) where
 
 #include "HsVersions.h"
@@ -30,26 +37,26 @@ import GHC.Prelude
 import GHC.Llvm.Syntax
 import GHC.Llvm.MetaData
 import GHC.Llvm.Types
-import GHC.Platform
 
+import Data.Int
 import Data.List ( intersperse )
 import GHC.Utils.Outputable
 import GHC.Types.Unique
-import GHC.Data.FastString ( sLit )
+import GHC.Data.FastString
 
 --------------------------------------------------------------------------------
 -- * Top Level Print functions
 --------------------------------------------------------------------------------
 
 -- | Print out a whole LLVM module.
-ppLlvmModule :: Platform -> LlvmModule -> SDoc
-ppLlvmModule platform (LlvmModule comments aliases meta globals decls funcs)
+ppLlvmModule :: LlvmOpts -> LlvmModule -> SDoc
+ppLlvmModule opts (LlvmModule comments aliases meta globals decls funcs)
   = ppLlvmComments comments $+$ newLine
     $+$ ppLlvmAliases aliases $+$ newLine
-    $+$ ppLlvmMetas meta $+$ newLine
-    $+$ ppLlvmGlobals globals $+$ newLine
+    $+$ ppLlvmMetas opts meta $+$ newLine
+    $+$ ppLlvmGlobals opts globals $+$ newLine
     $+$ ppLlvmFunctionDecls decls $+$ newLine
-    $+$ ppLlvmFunctions platform funcs
+    $+$ ppLlvmFunctions opts funcs
 
 -- | Print out a multi-line comment, can be inside a function or on its own
 ppLlvmComments :: [LMString] -> SDoc
@@ -61,12 +68,12 @@ ppLlvmComment com = semi <+> ftext com
 
 
 -- | Print out a list of global mutable variable definitions
-ppLlvmGlobals :: [LMGlobal] -> SDoc
-ppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls
+ppLlvmGlobals :: LlvmOpts -> [LMGlobal] -> SDoc
+ppLlvmGlobals opts ls = vcat $ map (ppLlvmGlobal opts) ls
 
 -- | Print out a global mutable variable definition
-ppLlvmGlobal :: LMGlobal -> SDoc
-ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
+ppLlvmGlobal :: LlvmOpts -> LMGlobal -> SDoc
+ppLlvmGlobal opts (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
     let sect = case x of
             Just x' -> text ", section" <+> doubleQuotes (ftext x')
             Nothing -> empty
@@ -76,7 +83,7 @@ ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
             Nothing -> empty
 
         rhs = case dat of
-            Just stat -> pprSpecialStatic stat
+            Just stat -> pprSpecialStatic opts stat
             Nothing   -> ppr (pLower $ getVarType var)
 
         -- Position of linkage is different for aliases.
@@ -85,11 +92,11 @@ ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
           Constant -> "constant"
           Alias    -> "alias"
 
-    in ppAssignment var $ ppr link <+> text const <+> rhs <> sect <> align
+    in ppAssignment opts var $ ppr link <+> text const <+> rhs <> sect <> align
        $+$ newLine
 
-ppLlvmGlobal (LMGlobal var val) = pprPanic "ppLlvmGlobal" $
-  text "Non Global var ppr as global! " <> ppr var <> text "=" <> ppr val
+ppLlvmGlobal opts (LMGlobal var val) = pprPanic "ppLlvmGlobal" $
+  text "Non Global var ppr as global! " <> ppVar opts var <> text "=" <> ppr (fmap (ppStatic opts) val)
 
 
 -- | Print out a list of LLVM type aliases.
@@ -103,38 +110,38 @@ ppLlvmAlias (name, ty)
 
 
 -- | Print out a list of LLVM metadata.
-ppLlvmMetas :: [MetaDecl] -> SDoc
-ppLlvmMetas metas = vcat $ map ppLlvmMeta metas
+ppLlvmMetas :: LlvmOpts -> [MetaDecl] -> SDoc
+ppLlvmMetas opts metas = vcat $ map (ppLlvmMeta opts) metas
 
 -- | Print out an LLVM metadata definition.
-ppLlvmMeta :: MetaDecl -> SDoc
-ppLlvmMeta (MetaUnnamed n m)
-  = ppr n <+> equals <+> ppr m
+ppLlvmMeta :: LlvmOpts -> MetaDecl -> SDoc
+ppLlvmMeta opts (MetaUnnamed n m)
+  = ppr n <+> equals <+> ppMetaExpr opts m
 
-ppLlvmMeta (MetaNamed n m)
+ppLlvmMeta _opts (MetaNamed n m)
   = exclamation <> ftext n <+> equals <+> exclamation <> braces nodes
   where
     nodes = hcat $ intersperse comma $ map ppr m
 
 
 -- | Print out a list of function definitions.
-ppLlvmFunctions :: Platform -> LlvmFunctions -> SDoc
-ppLlvmFunctions platform funcs = vcat $ map (ppLlvmFunction platform) funcs
+ppLlvmFunctions :: LlvmOpts -> LlvmFunctions -> SDoc
+ppLlvmFunctions opts funcs = vcat $ map (ppLlvmFunction opts) funcs
 
 -- | Print out a function definition.
-ppLlvmFunction :: Platform -> LlvmFunction -> SDoc
-ppLlvmFunction platform fun =
+ppLlvmFunction :: LlvmOpts -> LlvmFunction -> SDoc
+ppLlvmFunction opts fun =
     let attrDoc = ppSpaceJoin (funcAttrs fun)
         secDoc = case funcSect fun of
                       Just s' -> text "section" <+> (doubleQuotes $ ftext s')
                       Nothing -> empty
         prefixDoc = case funcPrefix fun of
-                        Just v  -> text "prefix" <+> ppr v
+                        Just v  -> text "prefix" <+> ppStatic opts v
                         Nothing -> empty
     in text "define" <+> ppLlvmFunctionHeader (funcDecl fun) (funcArgs fun)
         <+> attrDoc <+> secDoc <+> prefixDoc
         $+$ lbrace
-        $+$ ppLlvmBlocks platform (funcBody fun)
+        $+$ ppLlvmBlocks opts (funcBody fun)
         $+$ rbrace
         $+$ newLine
         $+$ newLine
@@ -178,21 +185,21 @@ ppLlvmFunctionDecl (LlvmFunctionDecl n l c r varg p a)
 
 
 -- | Print out a list of LLVM blocks.
-ppLlvmBlocks :: Platform -> LlvmBlocks -> SDoc
-ppLlvmBlocks platform blocks = vcat $ map (ppLlvmBlock platform) blocks
+ppLlvmBlocks :: LlvmOpts -> LlvmBlocks -> SDoc
+ppLlvmBlocks opts blocks = vcat $ map (ppLlvmBlock opts) blocks
 
 -- | Print out an LLVM block.
 -- It must be part of a function definition.
-ppLlvmBlock :: Platform -> LlvmBlock -> SDoc
-ppLlvmBlock platform (LlvmBlock blockId stmts) =
+ppLlvmBlock :: LlvmOpts -> LlvmBlock -> SDoc
+ppLlvmBlock opts (LlvmBlock blockId stmts) =
   let isLabel (MkLabel _) = True
       isLabel _           = False
       (block, rest)       = break isLabel stmts
       ppRest = case rest of
-        MkLabel id:xs -> ppLlvmBlock platform (LlvmBlock id xs)
+        MkLabel id:xs -> ppLlvmBlock opts (LlvmBlock id xs)
         _             -> empty
   in ppLlvmBlockLabel blockId
-           $+$ (vcat $ map (ppLlvmStatement platform) block)
+           $+$ (vcat $ map (ppLlvmStatement opts) block)
            $+$ newLine
            $+$ ppRest
 
@@ -202,47 +209,55 @@ ppLlvmBlockLabel id = pprUniqueAlways id <> colon
 
 
 -- | Print out an LLVM statement.
-ppLlvmStatement :: Platform -> LlvmStatement -> SDoc
-ppLlvmStatement platform stmt =
+ppLlvmStatement :: LlvmOpts -> LlvmStatement -> SDoc
+ppLlvmStatement opts stmt =
   let ind = (text "  " <>)
   in case stmt of
-        Assignment  dst expr      -> ind $ ppAssignment dst (ppLlvmExpression platform expr)
+        Assignment  dst expr      -> ind $ ppAssignment opts dst (ppLlvmExpression opts expr)
         Fence       st ord        -> ind $ ppFence st ord
-        Branch      target        -> ind $ ppBranch target
-        BranchIf    cond ifT ifF  -> ind $ ppBranchIf cond ifT ifF
+        Branch      target        -> ind $ ppBranch opts target
+        BranchIf    cond ifT ifF  -> ind $ ppBranchIf opts cond ifT ifF
         Comment     comments      -> ind $ ppLlvmComments comments
         MkLabel     label         -> ppLlvmBlockLabel label
-        Store       value ptr     -> ind $ ppStore value ptr
-        Switch      scrut def tgs -> ind $ ppSwitch scrut def tgs
-        Return      result        -> ind $ ppReturn result
-        Expr        expr          -> ind $ ppLlvmExpression platform expr
+        Store       value ptr     -> ind $ ppStore opts value ptr
+        Switch      scrut def tgs -> ind $ ppSwitch opts scrut def tgs
+        Return      result        -> ind $ ppReturn opts result
+        Expr        expr          -> ind $ ppLlvmExpression opts expr
         Unreachable               -> ind $ text "unreachable"
         Nop                       -> empty
-        MetaStmt    meta s        -> ppMetaStatement platform meta s
+        MetaStmt    meta s        -> ppMetaStatement opts meta s
 
 
 -- | Print out an LLVM expression.
-ppLlvmExpression :: Platform -> LlvmExpression -> SDoc
-ppLlvmExpression platform expr
+ppLlvmExpression :: LlvmOpts -> LlvmExpression -> SDoc
+ppLlvmExpression opts expr
   = case expr of
-        Alloca     tp amount        -> ppAlloca tp amount
-        LlvmOp     op left right    -> ppMachOp op left right
-        Call       tp fp args attrs -> ppCall tp fp (map MetaVar args) attrs
-        CallM      tp fp args attrs -> ppCall tp fp args attrs
-        Cast       op from to       -> ppCast op from to
-        Compare    op left right    -> ppCmpOp op left right
-        Extract    vec idx          -> ppExtract vec idx
-        ExtractV   struct idx       -> ppExtractV struct idx
-        Insert     vec elt idx      -> ppInsert vec elt idx
-        GetElemPtr inb ptr indexes  -> ppGetElementPtr inb ptr indexes
-        Load       ptr              -> ppLoad ptr
-        ALoad      ord st ptr       -> ppALoad platform ord st ptr
-        Malloc     tp amount        -> ppMalloc tp amount
-        AtomicRMW  aop tgt src ordering -> ppAtomicRMW aop tgt src ordering
-        CmpXChg    addr old new s_ord f_ord -> ppCmpXChg addr old new s_ord f_ord
-        Phi        tp predecessors  -> ppPhi tp predecessors
-        Asm        asm c ty v se sk -> ppAsm asm c ty v se sk
-        MExpr      meta expr        -> ppMetaExpr platform meta expr
+        Alloca     tp amount        -> ppAlloca opts tp amount
+        LlvmOp     op left right    -> ppMachOp opts op left right
+        Call       tp fp args attrs -> ppCall opts tp fp (map MetaVar args) attrs
+        CallM      tp fp args attrs -> ppCall opts tp fp args attrs
+        Cast       op from to       -> ppCast opts op from to
+        Compare    op left right    -> ppCmpOp opts op left right
+        Extract    vec idx          -> ppExtract opts vec idx
+        ExtractV   struct idx       -> ppExtractV opts struct idx
+        Insert     vec elt idx      -> ppInsert opts vec elt idx
+        GetElemPtr inb ptr indexes  -> ppGetElementPtr opts inb ptr indexes
+        Load       ptr              -> ppLoad opts ptr
+        ALoad      ord st ptr       -> ppALoad opts ord st ptr
+        Malloc     tp amount        -> ppMalloc opts tp amount
+        AtomicRMW  aop tgt src ordering -> ppAtomicRMW opts aop tgt src ordering
+        CmpXChg    addr old new s_ord f_ord -> ppCmpXChg opts addr old new s_ord f_ord
+        Phi        tp predecessors  -> ppPhi opts tp predecessors
+        Asm        asm c ty v se sk -> ppAsm opts asm c ty v se sk
+        MExpr      meta expr        -> ppMetaAnnotExpr opts meta expr
+
+ppMetaExpr :: LlvmOpts -> MetaExpr -> SDoc
+ppMetaExpr opts = \case
+  MetaVar (LMLitVar (LMNullLit _)) -> text "null"
+  MetaStr    s                     -> char '!' <> doubleQuotes (ftext s)
+  MetaNode   n                     -> ppr n
+  MetaVar    v                     -> ppVar opts v
+  MetaStruct es                    -> char '!' <> braces (ppCommaJoin (map (ppMetaExpr opts) es))
 
 
 --------------------------------------------------------------------------------
@@ -251,8 +266,8 @@ ppLlvmExpression platform expr
 
 -- | Should always be a function pointer. So a global var of function type
 -- (since globals are always pointers) or a local var of pointer function type.
-ppCall :: LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
-ppCall ct fptr args attrs = case fptr of
+ppCall :: LlvmOpts -> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
+ppCall opts ct fptr args attrs = case fptr of
                            --
     -- if local var function pointer, unwrap
     LMLocalVar _ (LMPointer (LMFunction d)) -> ppCall' d
@@ -269,29 +284,29 @@ ppCall ct fptr args attrs = case fptr of
         ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =
             let tc = if ct == TailCall then text "tail " else empty
                 ppValues = hsep $ punctuate comma $ map ppCallMetaExpr args
-                ppArgTy  = (ppCommaJoin $ map fst params) <>
+                ppArgTy  = (ppCommaJoin $ map (ppr . fst) params) <>
                            (case argTy of
                                VarArgs   -> text ", ..."
                                FixedArgs -> empty)
                 fnty = space <> lparen <> ppArgTy <> rparen
                 attrDoc = ppSpaceJoin attrs
             in  tc <> text "call" <+> ppr cc <+> ppr ret
-                    <> fnty <+> ppName fptr <> lparen <+> ppValues
+                    <> fnty <+> ppName opts fptr <> lparen <+> ppValues
                     <+> rparen <+> attrDoc
 
         -- Metadata needs to be marked as having the `metadata` type when used
         -- in a call argument
-        ppCallMetaExpr (MetaVar v) = ppr v
-        ppCallMetaExpr v           = text "metadata" <+> ppr v
+        ppCallMetaExpr (MetaVar v) = ppVar opts v
+        ppCallMetaExpr v           = text "metadata" <+> ppMetaExpr opts v
 
-ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
-ppMachOp op left right =
-  (ppr op) <+> (ppr (getVarType left)) <+> ppName left
-        <> comma <+> ppName right
+ppMachOp :: LlvmOpts -> LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
+ppMachOp opts op left right =
+  (ppr op) <+> (ppr (getVarType left)) <+> ppName opts left
+        <> comma <+> ppName opts right
 
 
-ppCmpOp :: LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
-ppCmpOp op left right =
+ppCmpOp :: LlvmOpts -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
+ppCmpOp opts op left right =
   let cmpOp
         | isInt (getVarType left) && isInt (getVarType right) = text "icmp"
         | isFloat (getVarType left) && isFloat (getVarType right) = text "fcmp"
@@ -302,11 +317,11 @@ ppCmpOp op left right =
                 ++ (show $ getVarType right))
         -}
   in cmpOp <+> ppr op <+> ppr (getVarType left)
-        <+> ppName left <> comma <+> ppName right
+        <+> ppName opts left <> comma <+> ppName opts right
 
 
-ppAssignment :: LlvmVar -> SDoc -> SDoc
-ppAssignment var expr = ppName var <+> equals <+> expr
+ppAssignment :: LlvmOpts -> LlvmVar -> SDoc -> SDoc
+ppAssignment opts var expr = ppName opts var <+> equals <+> expr
 
 ppFence :: Bool -> LlvmSyncOrdering -> SDoc
 ppFence st ord =
@@ -335,15 +350,15 @@ ppAtomicOp LAO_Min  = text "min"
 ppAtomicOp LAO_Umax = text "umax"
 ppAtomicOp LAO_Umin = text "umin"
 
-ppAtomicRMW :: LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
-ppAtomicRMW aop tgt src ordering =
-  text "atomicrmw" <+> ppAtomicOp aop <+> ppr tgt <> comma
-  <+> ppr src <+> ppSyncOrdering ordering
+ppAtomicRMW :: LlvmOpts -> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
+ppAtomicRMW opts aop tgt src ordering =
+  text "atomicrmw" <+> ppAtomicOp aop <+> ppVar opts tgt <> comma
+  <+> ppVar opts src <+> ppSyncOrdering ordering
 
-ppCmpXChg :: LlvmVar -> LlvmVar -> LlvmVar
+ppCmpXChg :: LlvmOpts -> LlvmVar -> LlvmVar -> LlvmVar
           -> LlvmSyncOrdering -> LlvmSyncOrdering -> SDoc
-ppCmpXChg addr old new s_ord f_ord =
-  text "cmpxchg" <+> ppr addr <> comma <+> ppr old <> comma <+> ppr new
+ppCmpXChg opts addr old new s_ord f_ord =
+  text "cmpxchg" <+> ppVar opts addr <> comma <+> ppVar opts old <> comma <+> ppVar opts new
   <+> ppSyncOrdering s_ord <+> ppSyncOrdering f_ord
 
 -- XXX: On x86, vector types need to be 16-byte aligned for aligned access, but
@@ -354,138 +369,228 @@ ppCmpXChg addr old new s_ord f_ord =
 -- access patterns are aligned, in which case we will need a more granular way
 -- of specifying alignment.
 
-ppLoad :: LlvmVar -> SDoc
-ppLoad var = text "load" <+> ppr derefType <> comma <+> ppr var <> align
+ppLoad :: LlvmOpts -> LlvmVar -> SDoc
+ppLoad opts var = text "load" <+> ppr derefType <> comma <+> ppVar opts var <> align
   where
     derefType = pLower $ getVarType var
     align | isVector . pLower . getVarType $ var = text ", align 1"
           | otherwise = empty
 
-ppALoad :: Platform -> LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc
-ppALoad platform ord st var =
-  let alignment = (llvmWidthInBits platform $ getVarType var) `quot` 8
+ppALoad :: LlvmOpts -> LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc
+ppALoad opts ord st var =
+  let alignment = (llvmWidthInBits (llvmOptsPlatform opts) $ getVarType var) `quot` 8
       align     = text ", align" <+> ppr alignment
       sThreaded | st        = text " singlethread"
                 | otherwise = empty
       derefType = pLower $ getVarType var
-  in text "load atomic" <+> ppr derefType <> comma <+> ppr var <> sThreaded
+  in text "load atomic" <+> ppr derefType <> comma <+> ppVar opts var <> sThreaded
             <+> ppSyncOrdering ord <> align
 
-ppStore :: LlvmVar -> LlvmVar -> SDoc
-ppStore val dst
-    | isVecPtrVar dst = text "store" <+> ppr val <> comma <+> ppr dst <>
+ppStore :: LlvmOpts -> LlvmVar -> LlvmVar -> SDoc
+ppStore opts val dst
+    | isVecPtrVar dst = text "store" <+> ppVar opts val <> comma <+> ppVar opts dst <>
                         comma <+> text "align 1"
-    | otherwise       = text "store" <+> ppr val <> comma <+> ppr dst
+    | otherwise       = text "store" <+> ppVar opts val <> comma <+> ppVar opts dst
   where
     isVecPtrVar :: LlvmVar -> Bool
     isVecPtrVar = isVector . pLower . getVarType
 
 
-ppCast :: LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
-ppCast op from to
+ppCast :: LlvmOpts -> LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
+ppCast opts op from to
     =   ppr op
-    <+> ppr (getVarType from) <+> ppName from
+    <+> ppr (getVarType from) <+> ppName opts from
     <+> text "to"
     <+> ppr to
 
 
-ppMalloc :: LlvmType -> Int -> SDoc
-ppMalloc tp amount =
+ppMalloc :: LlvmOpts -> LlvmType -> Int -> SDoc
+ppMalloc opts tp amount =
   let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
-  in text "malloc" <+> ppr tp <> comma <+> ppr amount'
+  in text "malloc" <+> ppr tp <> comma <+> ppVar opts amount'
 
 
-ppAlloca :: LlvmType -> Int -> SDoc
-ppAlloca tp amount =
+ppAlloca :: LlvmOpts -> LlvmType -> Int -> SDoc
+ppAlloca opts tp amount =
   let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
-  in text "alloca" <+> ppr tp <> comma <+> ppr amount'
+  in text "alloca" <+> ppr tp <> comma <+> ppVar opts amount'
 
 
-ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc
-ppGetElementPtr inb ptr idx =
-  let indexes = comma <+> ppCommaJoin idx
+ppGetElementPtr :: LlvmOpts -> Bool -> LlvmVar -> [LlvmVar] -> SDoc
+ppGetElementPtr opts inb ptr idx =
+  let indexes = comma <+> ppCommaJoin (map (ppVar opts) idx)
       inbound = if inb then text "inbounds" else empty
       derefType = pLower $ getVarType ptr
-  in text "getelementptr" <+> inbound <+> ppr derefType <> comma <+> ppr ptr
+  in text "getelementptr" <+> inbound <+> ppr derefType <> comma <+> ppVar opts ptr
                             <> indexes
 
 
-ppReturn :: Maybe LlvmVar -> SDoc
-ppReturn (Just var) = text "ret" <+> ppr var
-ppReturn Nothing    = text "ret" <+> ppr LMVoid
+ppReturn :: LlvmOpts -> Maybe LlvmVar -> SDoc
+ppReturn opts (Just var) = text "ret" <+> ppVar opts var
+ppReturn _    Nothing    = text "ret" <+> ppr LMVoid
 
 
-ppBranch :: LlvmVar -> SDoc
-ppBranch var = text "br" <+> ppr var
+ppBranch :: LlvmOpts -> LlvmVar -> SDoc
+ppBranch opts var = text "br" <+> ppVar opts var
 
 
-ppBranchIf :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
-ppBranchIf cond trueT falseT
-  = text "br" <+> ppr cond <> comma <+> ppr trueT <> comma <+> ppr falseT
+ppBranchIf :: LlvmOpts -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
+ppBranchIf opts cond trueT falseT
+  = text "br" <+> ppVar opts cond <> comma <+> ppVar opts trueT <> comma <+> ppVar opts falseT
 
 
-ppPhi :: LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc
-ppPhi tp preds =
-  let ppPreds (val, label) = brackets $ ppName val <> comma <+> ppName label
+ppPhi :: LlvmOpts -> LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc
+ppPhi opts tp preds =
+  let ppPreds (val, label) = brackets $ ppName opts val <> comma <+> ppName opts label
   in text "phi" <+> ppr tp <+> hsep (punctuate comma $ map ppPreds preds)
 
 
-ppSwitch :: LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc
-ppSwitch scrut dflt targets =
-  let ppTarget  (val, lab) = ppr val <> comma <+> ppr lab
+ppSwitch :: LlvmOpts -> LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc
+ppSwitch opts scrut dflt targets =
+  let ppTarget  (val, lab) = ppVar opts val <> comma <+> ppVar opts lab
       ppTargets  xs        = brackets $ vcat (map ppTarget xs)
-  in text "switch" <+> ppr scrut <> comma <+> ppr dflt
+  in text "switch" <+> ppVar opts scrut <> comma <+> ppVar opts dflt
         <+> ppTargets targets
 
 
-ppAsm :: LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
-ppAsm asm constraints rty vars sideeffect alignstack =
+ppAsm :: LlvmOpts -> LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
+ppAsm opts asm constraints rty vars sideeffect alignstack =
   let asm'  = doubleQuotes $ ftext asm
       cons  = doubleQuotes $ ftext constraints
       rty'  = ppr rty
-      vars' = lparen <+> ppCommaJoin vars <+> rparen
+      vars' = lparen <+> ppCommaJoin (map (ppVar opts) vars) <+> rparen
       side  = if sideeffect then text "sideeffect" else empty
       align = if alignstack then text "alignstack" else empty
   in text "call" <+> rty' <+> text "asm" <+> side <+> align <+> asm' <> comma
         <+> cons <> vars'
 
-ppExtract :: LlvmVar -> LlvmVar -> SDoc
-ppExtract vec idx =
+ppExtract :: LlvmOpts -> LlvmVar -> LlvmVar -> SDoc
+ppExtract opts vec idx =
     text "extractelement"
-    <+> ppr (getVarType vec) <+> ppName vec <> comma
-    <+> ppr idx
+    <+> ppr (getVarType vec) <+> ppName opts vec <> comma
+    <+> ppVar opts idx
 
-ppExtractV :: LlvmVar -> Int -> SDoc
-ppExtractV struct idx =
+ppExtractV :: LlvmOpts -> LlvmVar -> Int -> SDoc
+ppExtractV opts struct idx =
     text "extractvalue"
-    <+> ppr (getVarType struct) <+> ppName struct <> comma
+    <+> ppr (getVarType struct) <+> ppName opts struct <> comma
     <+> ppr idx
 
-ppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
-ppInsert vec elt idx =
+ppInsert :: LlvmOpts -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
+ppInsert opts vec elt idx =
     text "insertelement"
-    <+> ppr (getVarType vec) <+> ppName vec <> comma
-    <+> ppr (getVarType elt) <+> ppName elt <> comma
-    <+> ppr idx
+    <+> ppr (getVarType vec) <+> ppName opts vec <> comma
+    <+> ppr (getVarType elt) <+> ppName opts elt <> comma
+    <+> ppVar opts idx
 
 
-ppMetaStatement :: Platform -> [MetaAnnot] -> LlvmStatement -> SDoc
-ppMetaStatement platform meta stmt =
-   ppLlvmStatement platform stmt <> ppMetaAnnots meta
+ppMetaStatement :: LlvmOpts -> [MetaAnnot] -> LlvmStatement -> SDoc
+ppMetaStatement opts meta stmt =
+   ppLlvmStatement opts stmt <> ppMetaAnnots opts meta
 
-ppMetaExpr :: Platform -> [MetaAnnot] -> LlvmExpression -> SDoc
-ppMetaExpr platform meta expr =
-   ppLlvmExpression platform expr <> ppMetaAnnots meta
+ppMetaAnnotExpr :: LlvmOpts -> [MetaAnnot] -> LlvmExpression -> SDoc
+ppMetaAnnotExpr opts meta expr =
+   ppLlvmExpression opts expr <> ppMetaAnnots opts meta
 
-ppMetaAnnots :: [MetaAnnot] -> SDoc
-ppMetaAnnots meta = hcat $ map ppMeta meta
+ppMetaAnnots :: LlvmOpts -> [MetaAnnot] -> SDoc
+ppMetaAnnots opts meta = hcat $ map ppMeta meta
   where
     ppMeta (MetaAnnot name e)
         = comma <+> exclamation <> ftext name <+>
           case e of
             MetaNode n    -> ppr n
-            MetaStruct ms -> exclamation <> braces (ppCommaJoin ms)
-            other         -> exclamation <> braces (ppr other) -- possible?
+            MetaStruct ms -> exclamation <> braces (ppCommaJoin (map (ppMetaExpr opts) ms))
+            other         -> exclamation <> braces (ppMetaExpr opts other) -- possible?
+
+-- | Return the variable name or value of the 'LlvmVar'
+-- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@).
+ppName :: LlvmOpts -> LlvmVar -> SDoc
+ppName opts v = case v of
+   LMGlobalVar {} -> char '@' <> ppPlainName opts v
+   LMLocalVar  {} -> char '%' <> ppPlainName opts v
+   LMNLocalVar {} -> char '%' <> ppPlainName opts v
+   LMLitVar    {} ->             ppPlainName opts v
+
+-- | Return the variable name or value of the 'LlvmVar'
+-- in a plain textual representation (e.g. @x@, @y@ or @42@).
+ppPlainName :: LlvmOpts -> LlvmVar -> SDoc
+ppPlainName opts v = case v of
+   (LMGlobalVar x _ _ _ _ _) -> ftext x
+   (LMLocalVar  x LMLabel  ) -> text (show x)
+   (LMLocalVar  x _        ) -> text ('l' : show x)
+   (LMNLocalVar x _        ) -> ftext x
+   (LMLitVar    x          ) -> ppLit opts x
+
+-- | Print a literal value. No type.
+ppLit :: LlvmOpts -> LlvmLit -> SDoc
+ppLit opts l = case l of
+   (LMIntLit i (LMInt 32))  -> ppr (fromInteger i :: Int32)
+   (LMIntLit i (LMInt 64))  -> ppr (fromInteger i :: Int64)
+   (LMIntLit   i _       )  -> ppr ((fromInteger i)::Int)
+   (LMFloatLit r LMFloat )  -> ppFloat (llvmOptsPlatform opts) $ narrowFp r
+   (LMFloatLit r LMDouble)  -> ppDouble (llvmOptsPlatform opts) r
+   f@(LMFloatLit _ _)       -> pprPanic "ppLit" (text "Can't print this float literal: " <> ppTypeLit opts f)
+   (LMVectorLit ls  )       -> char '<' <+> ppCommaJoin (map (ppTypeLit opts) ls) <+> char '>'
+   (LMNullLit _     )       -> text "null"
+   -- #11487 was an issue where we passed undef for some arguments
+   -- that were actually live. By chance the registers holding those
+   -- arguments usually happened to have the right values anyways, but
+   -- that was not guaranteed. To find such bugs reliably, we set the
+   -- flag below when validating, which replaces undef literals (at
+   -- common types) with values that are likely to cause a crash or test
+   -- failure.
+   (LMUndefLit t    )
+      | llvmOptsFillUndefWithGarbage opts
+      , Just lit <- garbageLit t   -> ppLit opts lit
+      | otherwise                  -> text "undef"
+
+ppVar :: LlvmOpts -> LlvmVar -> SDoc
+ppVar opts v = case v of
+  LMLitVar x -> ppTypeLit opts x
+  x          -> ppr (getVarType x) <+> ppName opts x
+
+ppTypeLit :: LlvmOpts -> LlvmLit -> SDoc
+ppTypeLit opts l = case l of
+  LMVectorLit {} -> ppLit opts l
+  _              -> ppr (getLitType l) <+> ppLit opts l
+
+ppStatic :: LlvmOpts -> LlvmStatic -> SDoc
+ppStatic opts st = case st of
+  LMComment       s -> text "; " <> ftext s
+  LMStaticLit   l   -> ppTypeLit opts l
+  LMUninitType    t -> ppr t <> text " undef"
+  LMStaticStr   s t -> ppr t <> text " c\"" <> ftext s <> text "\\00\""
+  LMStaticArray d t -> ppr t <> text " [" <> ppCommaJoin (map (ppStatic opts) d) <> char ']'
+  LMStaticStruc d t -> ppr t <> text "<{" <> ppCommaJoin (map (ppStatic opts) d) <> text "}>"
+  LMStaticPointer v -> ppVar opts v
+  LMTrunc v t       -> ppr t <> text " trunc (" <> ppStatic opts v <> text " to " <> ppr t <> char ')'
+  LMBitc v t        -> ppr t <> text " bitcast (" <> ppStatic opts v <> text " to " <> ppr t <> char ')'
+  LMPtoI v t        -> ppr t <> text " ptrtoint (" <> ppStatic opts v <> text " to " <> ppr t <> char ')'
+  LMAdd s1 s2       -> pprStaticArith opts s1 s2 (sLit "add") (sLit "fadd") "LMAdd"
+  LMSub s1 s2       -> pprStaticArith opts s1 s2 (sLit "sub") (sLit "fsub") "LMSub"
+
+
+pprSpecialStatic :: LlvmOpts -> LlvmStatic -> SDoc
+pprSpecialStatic opts stat = case stat of
+   LMBitc v t        -> ppr (pLower t)
+                        <> text ", bitcast ("
+                        <> ppStatic opts v <> text " to " <> ppr t
+                        <> char ')'
+   LMStaticPointer x -> ppr (pLower $ getVarType x)
+                        <> comma <+> ppStatic opts stat
+   _                 -> ppStatic opts stat
+
+
+pprStaticArith :: LlvmOpts -> LlvmStatic -> LlvmStatic -> PtrString -> PtrString
+                  -> String -> SDoc
+pprStaticArith opts s1 s2 int_op float_op op_name =
+  let ty1 = getStatType s1
+      op  = if isFloat ty1 then float_op else int_op
+  in if ty1 == getStatType s2
+     then ppr ty1 <+> ptext op <+> lparen <> ppStatic opts s1 <> comma <> ppStatic opts s2 <> rparen
+     else pprPanic "pprStaticArith" $
+            text op_name <> text " with different types! s1: " <> ppStatic opts s1
+                         <> text", s2: " <> ppStatic opts s2
 
 
 --------------------------------------------------------------------------------
diff --git a/compiler/GHC/Llvm/Types.hs b/compiler/GHC/Llvm/Types.hs
index 5a59c5c8fb..3fbff4837c 100644
--- a/compiler/GHC/Llvm/Types.hs
+++ b/compiler/GHC/Llvm/Types.hs
@@ -12,7 +12,6 @@ module GHC.Llvm.Types where
 import GHC.Prelude
 
 import Data.Char
-import Data.Int
 import Numeric
 
 import GHC.Platform
@@ -64,24 +63,26 @@ data LlvmType
   deriving (Eq)
 
 instance Outputable LlvmType where
-  ppr (LMInt size     ) = char 'i' <> ppr size
-  ppr (LMFloat        ) = text "float"
-  ppr (LMDouble       ) = text "double"
-  ppr (LMFloat80      ) = text "x86_fp80"
-  ppr (LMFloat128     ) = text "fp128"
-  ppr (LMPointer x    ) = ppr x <> char '*'
-  ppr (LMArray nr tp  ) = char '[' <> ppr nr <> text " x " <> ppr tp <> char ']'
-  ppr (LMVector nr tp ) = char '<' <> ppr nr <> text " x " <> ppr tp <> char '>'
-  ppr (LMLabel        ) = text "label"
-  ppr (LMVoid         ) = text "void"
-  ppr (LMStruct tys   ) = text "<{" <> ppCommaJoin tys <> text "}>"
-  ppr (LMStructU tys  ) = text "{" <> ppCommaJoin tys <> text "}"
-  ppr (LMMetadata     ) = text "metadata"
-
-  ppr (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))
-    = ppr r <+> lparen <> ppParams varg p <> rparen
-
-  ppr (LMAlias (s,_)) = char '%' <> ftext s
+  ppr = ppType
+
+ppType :: LlvmType -> SDoc
+ppType t = case t of
+  LMInt size     -> char 'i' <> ppr size
+  LMFloat        -> text "float"
+  LMDouble       -> text "double"
+  LMFloat80      -> text "x86_fp80"
+  LMFloat128     -> text "fp128"
+  LMPointer x    -> ppr x <> char '*'
+  LMArray nr tp  -> char '[' <> ppr nr <> text " x " <> ppr tp <> char ']'
+  LMVector nr tp -> char '<' <> ppr nr <> text " x " <> ppr tp <> char '>'
+  LMLabel        -> text "label"
+  LMVoid         -> text "void"
+  LMStruct tys   -> text "<{" <> ppCommaJoin tys <> text "}>"
+  LMStructU tys  -> text "{" <> ppCommaJoin tys <> text "}"
+  LMMetadata     -> text "metadata"
+  LMAlias (s,_)  -> char '%' <> ftext s
+  LMFunction (LlvmFunctionDecl _ _ _ r varg p _)
+    -> ppr r <+> lparen <> ppParams varg p <> rparen
 
 ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
 ppParams varg p
@@ -115,11 +116,6 @@ data LlvmVar
   | LMLitVar LlvmLit
   deriving (Eq)
 
-instance Outputable LlvmVar where
-  ppr (LMLitVar x)  = ppr x
-  ppr (x         )  = ppr (getVarType x) <+> ppName x
-
-
 -- | Llvm Literal Data.
 --
 -- These can be used inline in expressions.
@@ -136,11 +132,6 @@ data LlvmLit
   | LMUndefLit LlvmType
   deriving (Eq)
 
-instance Outputable LlvmLit where
-  ppr l@(LMVectorLit {}) = ppLit l
-  ppr l                  = ppr (getLitType l) <+> ppLit l
-
-
 -- | Llvm Static Data.
 --
 -- These represent the possible global level variables and constants.
@@ -162,89 +153,24 @@ data LlvmStatic
   | LMAdd LlvmStatic LlvmStatic        -- ^ Constant addition operation
   | LMSub LlvmStatic LlvmStatic        -- ^ Constant subtraction operation
 
-instance Outputable LlvmStatic where
-  ppr (LMComment       s) = text "; " <> ftext s
-  ppr (LMStaticLit   l  ) = ppr l
-  ppr (LMUninitType    t) = ppr t <> text " undef"
-  ppr (LMStaticStr   s t) = ppr t <> text " c\"" <> ftext s <> text "\\00\""
-  ppr (LMStaticArray d t) = ppr t <> text " [" <> ppCommaJoin d <> char ']'
-  ppr (LMStaticStruc d t) = ppr t <> text "<{" <> ppCommaJoin d <> text "}>"
-  ppr (LMStaticPointer v) = ppr v
-  ppr (LMTrunc v t)
-      = ppr t <> text " trunc (" <> ppr v <> text " to " <> ppr t <> char ')'
-  ppr (LMBitc v t)
-      = ppr t <> text " bitcast (" <> ppr v <> text " to " <> ppr t <> char ')'
-  ppr (LMPtoI v t)
-      = ppr t <> text " ptrtoint (" <> ppr v <> text " to " <> ppr t <> char ')'
-
-  ppr (LMAdd s1 s2)
-      = pprStaticArith s1 s2 (sLit "add") (sLit "fadd") "LMAdd"
-  ppr (LMSub s1 s2)
-      = pprStaticArith s1 s2 (sLit "sub") (sLit "fsub") "LMSub"
-
-
-pprSpecialStatic :: LlvmStatic -> SDoc
-pprSpecialStatic (LMBitc v t) =
-    ppr (pLower t) <> text ", bitcast (" <> ppr v <> text " to " <> ppr t
-        <> char ')'
-pprSpecialStatic v@(LMStaticPointer x) = ppr (pLower $ getVarType x) <> comma <+> ppr v
-pprSpecialStatic stat = ppr stat
-
-
-pprStaticArith :: LlvmStatic -> LlvmStatic -> PtrString -> PtrString
-                  -> String -> SDoc
-pprStaticArith s1 s2 int_op float_op op_name =
-  let ty1 = getStatType s1
-      op  = if isFloat ty1 then float_op else int_op
-  in if ty1 == getStatType s2
-     then ppr ty1 <+> ptext op <+> lparen <> ppr s1 <> comma <> ppr s2 <> rparen
-     else pprPanic "pprStaticArith" $
-            text op_name <> text " with different types! s1: " <> ppr s1
-                         <> text", s2: " <> ppr s2
-
 -- -----------------------------------------------------------------------------
 -- ** Operations on LLVM Basic Types and Variables
 --
 
--- | Return the variable name or value of the 'LlvmVar'
--- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@).
-ppName :: LlvmVar -> SDoc
-ppName v@(LMGlobalVar {}) = char '@' <> ppPlainName v
-ppName v@(LMLocalVar  {}) = char '%' <> ppPlainName v
-ppName v@(LMNLocalVar {}) = char '%' <> ppPlainName v
-ppName v@(LMLitVar    {}) =             ppPlainName v
-
--- | Return the variable name or value of the 'LlvmVar'
--- in a plain textual representation (e.g. @x@, @y@ or @42@).
-ppPlainName :: LlvmVar -> SDoc
-ppPlainName (LMGlobalVar x _ _ _ _ _) = ftext x
-ppPlainName (LMLocalVar  x LMLabel  ) = text (show x)
-ppPlainName (LMLocalVar  x _        ) = text ('l' : show x)
-ppPlainName (LMNLocalVar x _        ) = ftext x
-ppPlainName (LMLitVar    x          ) = ppLit x
-
--- | Print a literal value. No type.
-ppLit :: LlvmLit -> SDoc
-ppLit l = sdocWithDynFlags $ \dflags -> case l of
-   (LMIntLit i (LMInt 32))  -> ppr (fromInteger i :: Int32)
-   (LMIntLit i (LMInt 64))  -> ppr (fromInteger i :: Int64)
-   (LMIntLit   i _       )  -> ppr ((fromInteger i)::Int)
-   (LMFloatLit r LMFloat )  -> ppFloat (targetPlatform dflags) $ narrowFp r
-   (LMFloatLit r LMDouble)  -> ppDouble (targetPlatform dflags) r
-   f@(LMFloatLit _ _)       -> pprPanic "ppLit" (text "Can't print this float literal: " <> ppr f)
-   (LMVectorLit ls  )       -> char '<' <+> ppCommaJoin ls <+> char '>'
-   (LMNullLit _     )       -> text "null"
-   -- #11487 was an issue where we passed undef for some arguments
-   -- that were actually live. By chance the registers holding those
-   -- arguments usually happened to have the right values anyways, but
-   -- that was not guaranteed. To find such bugs reliably, we set the
-   -- flag below when validating, which replaces undef literals (at
-   -- common types) with values that are likely to cause a crash or test
-   -- failure.
-   (LMUndefLit t    )
-      | gopt Opt_LlvmFillUndefWithGarbage dflags
-      , Just lit <- garbageLit t   -> ppLit lit
-      | otherwise                  -> text "undef"
+-- | LLVM code generator options
+data LlvmOpts = LlvmOpts
+   { llvmOptsPlatform             :: !Platform -- ^ Target platform
+   , llvmOptsFillUndefWithGarbage :: !Bool     -- ^ Fill undefined literals with garbage values
+   , llvmOptsSplitSections        :: !Bool     -- ^ Split sections
+   }
+
+-- | Get LlvmOptions from DynFlags
+initLlvmOpts :: DynFlags -> LlvmOpts
+initLlvmOpts dflags = LlvmOpts
+   { llvmOptsPlatform             = targetPlatform dflags
+   , llvmOptsFillUndefWithGarbage = gopt Opt_LlvmFillUndefWithGarbage dflags
+   , llvmOptsSplitSections        = gopt Opt_SplitSections dflags
+   }
 
 garbageLit :: LlvmType -> Maybe LlvmLit
 garbageLit t@(LMInt w)     = Just (LMIntLit (0xbbbbbbbbbbbbbbb0 `mod` (2^w)) t)