Modules: Llvm (#13009)

12 files changed, 5361 insertions, 0 deletions

diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs
new file mode 100644
index 0000000000..f84c2901a5
--- /dev/null
+++ b/compiler/GHC/CmmToLlvm.hs
@@ -0,0 +1,222 @@
+{-# LANGUAGE CPP, TypeFamilies, ViewPatterns, OverloadedStrings #-}
+
+-- -----------------------------------------------------------------------------
+-- | This is the top-level module in the LLVM code generator.
+--
+module GHC.CmmToLlvm
+   ( LlvmVersion
+   , llvmVersionList
+   , llvmCodeGen
+   , llvmFixupAsm
+   )
+where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Llvm
+import GHC.CmmToLlvm.Base
+import GHC.CmmToLlvm.CodeGen
+import GHC.CmmToLlvm.Data
+import GHC.CmmToLlvm.Ppr
+import GHC.CmmToLlvm.Regs
+import GHC.CmmToLlvm.Mangler
+
+import GHC.StgToCmm.CgUtils ( fixStgRegisters )
+import GHC.Cmm
+import GHC.Cmm.Dataflow.Collections
+import GHC.Cmm.Ppr
+
+import BufWrite
+import DynFlags
+import GHC.Platform ( platformArch, Arch(..) )
+import ErrUtils
+import FastString
+import Outputable
+import SysTools ( figureLlvmVersion )
+import qualified Stream
+
+import Control.Monad ( when, forM_ )
+import Data.Maybe ( fromMaybe, catMaybes )
+import System.IO
+
+-- -----------------------------------------------------------------------------
+-- | Top-level of the LLVM Code generator
+--
+llvmCodeGen :: DynFlags -> Handle
+               -> Stream.Stream IO RawCmmGroup a
+               -> IO a
+llvmCodeGen dflags h cmm_stream
+  = withTiming dflags (text "LLVM CodeGen") (const ()) $ do
+       bufh <- newBufHandle h
+
+       -- Pass header
+       showPass dflags "LLVM CodeGen"
+
+       -- get llvm version, cache for later use
+       mb_ver <- figureLlvmVersion dflags
+
+       -- warn if unsupported
+       forM_ mb_ver $ \ver -> do
+         debugTraceMsg dflags 2
+              (text "Using LLVM version:" <+> text (llvmVersionStr ver))
+         let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags
+         when (not (llvmVersionSupported ver) && doWarn) $ putMsg dflags $
+           "You are using an unsupported version of LLVM!" $$
+           "Currently only " <> text (llvmVersionStr supportedLlvmVersion) <> " is supported." <+>
+           "System LLVM version: " <> text (llvmVersionStr ver) $$
+           "We will try though..."
+         let isS390X = platformArch (targetPlatform dflags) == ArchS390X
+         let major_ver = head . llvmVersionList $ ver
+         when (isS390X && major_ver < 10 && doWarn) $ putMsg dflags $
+           "Warning: For s390x the GHC calling convention is only supported since LLVM version 10." <+>
+           "You are using LLVM version: " <> text (llvmVersionStr ver)
+
+       -- run code generation
+       a <- runLlvm dflags (fromMaybe supportedLlvmVersion mb_ver) bufh $
+         llvmCodeGen' (liftStream cmm_stream)
+
+       bFlush bufh
+
+       return a
+
+llvmCodeGen' :: Stream.Stream LlvmM RawCmmGroup a -> LlvmM a
+llvmCodeGen' cmm_stream
+  = do  -- Preamble
+        renderLlvm header
+        ghcInternalFunctions
+        cmmMetaLlvmPrelude
+
+        -- Procedures
+        a <- Stream.consume cmm_stream llvmGroupLlvmGens
+
+        -- Declare aliases for forward references
+        renderLlvm . pprLlvmData =<< generateExternDecls
+
+        -- Postamble
+        cmmUsedLlvmGens
+
+        return a
+  where
+    header :: SDoc
+    header = sdocWithDynFlags $ \dflags ->
+      let target = platformMisc_llvmTarget $ platformMisc dflags
+      in     text ("target datalayout = \"" ++ getDataLayout dflags target ++ "\"")
+         $+$ text ("target triple = \"" ++ target ++ "\"")
+
+    getDataLayout :: DynFlags -> String -> String
+    getDataLayout dflags target =
+      case lookup target (llvmTargets $ llvmConfig dflags) of
+        Just (LlvmTarget {lDataLayout=dl}) -> dl
+        Nothing -> pprPanic "Failed to lookup LLVM data layout" $
+                   text "Target:" <+> text target $$
+                   hang (text "Available targets:") 4
+                        (vcat $ map (text . fst) $ llvmTargets $ llvmConfig dflags)
+
+llvmGroupLlvmGens :: RawCmmGroup -> LlvmM ()
+llvmGroupLlvmGens cmm = do
+
+        -- Insert functions into map, collect data
+        let split (CmmData s d' )     = return $ Just (s, d')
+            split (CmmProc h l live g) = do
+              -- Set function type
+              let l' = case mapLookup (g_entry g) h of
+                         Nothing                   -> l
+                         Just (RawCmmStatics info_lbl _) -> info_lbl
+              lml <- strCLabel_llvm l'
+              funInsert lml =<< llvmFunTy live
+              return Nothing
+        cdata <- fmap catMaybes $ mapM split cmm
+
+        {-# SCC "llvm_datas_gen" #-}
+          cmmDataLlvmGens cdata
+        {-# SCC "llvm_procs_gen" #-}
+          mapM_ cmmLlvmGen cmm
+
+-- -----------------------------------------------------------------------------
+-- | Do LLVM code generation on all these Cmms data sections.
+--
+cmmDataLlvmGens :: [(Section,RawCmmStatics)] -> LlvmM ()
+
+cmmDataLlvmGens statics
+  = do lmdatas <- mapM genLlvmData statics
+
+       let (concat -> gs, tss) = unzip lmdatas
+
+       let regGlobal (LMGlobal (LMGlobalVar l ty _ _ _ _) _)
+                        = funInsert l ty
+           regGlobal _  = pure ()
+       mapM_ regGlobal gs
+       gss' <- mapM aliasify $ gs
+
+       renderLlvm $ pprLlvmData (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
+    let fixed_cmm = {-# SCC "llvm_fix_regs" #-} fixStgRegisters dflags cmm
+
+    dumpIfSetLlvm Opt_D_dump_opt_cmm "Optimised Cmm"
+      FormatCMM (pprCmmGroup [fixed_cmm])
+
+    -- generate llvm code from cmm
+    llvmBC <- withClearVars $ genLlvmProc fixed_cmm
+
+    -- pretty print
+    (docs, ivars) <- fmap unzip $ mapM pprLlvmCmmDecl llvmBC
+
+    -- Output, note down used variables
+    renderLlvm (vcat docs)
+    mapM_ markUsedVar $ concat ivars
+
+cmmLlvmGen _ = return ()
+
+-- -----------------------------------------------------------------------------
+-- | Generate meta data nodes
+--
+
+cmmMetaLlvmPrelude :: LlvmM ()
+cmmMetaLlvmPrelude = do
+  metas <- flip mapM stgTBAA $ \(uniq, name, parent) -> do
+    -- Generate / lookup meta data IDs
+    tbaaId <- getMetaUniqueId
+    setUniqMeta uniq tbaaId
+    parentId <- maybe (return Nothing) getUniqMeta parent
+    -- Build definition
+    return $ MetaUnnamed tbaaId $ MetaStruct $
+          case parentId of
+              Just p  -> [ MetaStr name, MetaNode p ]
+              -- As of LLVM 4.0, a node without parents should be rendered as
+              -- just a name on its own. Previously `null` was accepted as the
+              -- name.
+              Nothing -> [ MetaStr name ]
+  renderLlvm $ ppLlvmMetas metas
+
+-- -----------------------------------------------------------------------------
+-- | Marks variables as used where necessary
+--
+
+cmmUsedLlvmGens :: LlvmM ()
+cmmUsedLlvmGens = do
+
+  -- LLVM would discard variables that are internal and not obviously
+  -- used if we didn't provide these hints. This will generate a
+  -- definition of the form
+  --
+  --   @llvm.used = appending global [42 x i8*] [i8* bitcast <var> to i8*, ...]
+  --
+  -- Which is the LLVM way of protecting them against getting removed.
+  ivars <- getUsedVars
+  let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
+      ty     = (LMArray (length ivars) i8Ptr)
+      usedArray = LMStaticArray (map cast ivars) ty
+      sectName  = Just $ fsLit "llvm.metadata"
+      lmUsedVar = LMGlobalVar (fsLit "llvm.used") ty Appending sectName Nothing Constant
+      lmUsed    = LMGlobal lmUsedVar (Just usedArray)
+  if null ivars
+     then return ()
+     else renderLlvm $ pprLlvmData ([lmUsed], [])
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
new file mode 100644
index 0000000000..c0bd742840
--- /dev/null
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -0,0 +1,685 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- ----------------------------------------------------------------------------
+-- | Base LLVM Code Generation module
+--
+-- Contains functions useful through out the code generator.
+--
+
+module GHC.CmmToLlvm.Base (
+
+        LlvmCmmDecl, LlvmBasicBlock,
+        LiveGlobalRegs,
+        LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
+
+        LlvmVersion, supportedLlvmVersion, llvmVersionSupported, parseLlvmVersion,
+        llvmVersionStr, llvmVersionList,
+
+        LlvmM,
+        runLlvm, liftStream, withClearVars, varLookup, varInsert,
+        markStackReg, checkStackReg,
+        funLookup, funInsert, getLlvmVer, getDynFlags, getDynFlag, getLlvmPlatform,
+        dumpIfSetLlvm, renderLlvm, markUsedVar, getUsedVars,
+        ghcInternalFunctions,
+
+        getMetaUniqueId,
+        setUniqMeta, getUniqMeta,
+
+        cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
+        llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
+        llvmPtrBits, tysToParams, llvmFunSection, padLiveArgs, isFPR,
+
+        strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
+        getGlobalPtr, generateExternDecls,
+
+        aliasify, llvmDefLabel
+    ) where
+
+#include "HsVersions.h"
+#include "ghcautoconf.h"
+
+import GhcPrelude
+
+import GHC.Llvm
+import GHC.CmmToLlvm.Regs
+
+import GHC.Cmm.CLabel
+import GHC.Platform.Regs ( activeStgRegs )
+import DynFlags
+import FastString
+import GHC.Cmm              hiding ( succ )
+import GHC.Cmm.Utils (regsOverlap)
+import Outputable as Outp
+import GHC.Platform
+import UniqFM
+import Unique
+import BufWrite   ( BufHandle )
+import UniqSet
+import UniqSupply
+import ErrUtils
+import qualified Stream
+
+import Data.Maybe (fromJust)
+import Control.Monad (ap)
+import Data.Char (isDigit)
+import Data.List (sort, groupBy, intercalate)
+import qualified Data.List.NonEmpty as NE
+
+-- ----------------------------------------------------------------------------
+-- * Some Data Types
+--
+
+type LlvmCmmDecl = GenCmmDecl [LlvmData] (Maybe RawCmmStatics) (ListGraph LlvmStatement)
+type LlvmBasicBlock = GenBasicBlock LlvmStatement
+
+-- | Global registers live on proc entry
+type LiveGlobalRegs = [GlobalReg]
+
+-- | Unresolved code.
+-- Of the form: (data label, data type, unresolved data)
+type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic])
+
+-- | Top level LLVM Data (globals and type aliases)
+type LlvmData = ([LMGlobal], [LlvmType])
+
+-- | An unresolved Label.
+--
+-- Labels are unresolved when we haven't yet determined if they are defined in
+-- the module we are currently compiling, or an external one.
+type UnresLabel  = CmmLit
+type UnresStatic = Either UnresLabel LlvmStatic
+
+-- ----------------------------------------------------------------------------
+-- * Type translations
+--
+
+-- | Translate a basic CmmType to an LlvmType.
+cmmToLlvmType :: CmmType -> LlvmType
+cmmToLlvmType ty | isVecType ty   = LMVector (vecLength ty) (cmmToLlvmType (vecElemType ty))
+                 | isFloatType ty = widthToLlvmFloat $ typeWidth ty
+                 | otherwise      = widthToLlvmInt   $ typeWidth ty
+
+-- | Translate a Cmm Float Width to a LlvmType.
+widthToLlvmFloat :: Width -> LlvmType
+widthToLlvmFloat W32  = LMFloat
+widthToLlvmFloat W64  = LMDouble
+widthToLlvmFloat W128 = LMFloat128
+widthToLlvmFloat w    = panic $ "widthToLlvmFloat: Bad float size: " ++ show w
+
+-- | Translate a Cmm Bit Width to a LlvmType.
+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
+
+-- | Llvm Function type for Cmm function
+llvmFunTy :: LiveGlobalRegs -> LlvmM LlvmType
+llvmFunTy live = return . LMFunction =<< llvmFunSig' live (fsLit "a") ExternallyVisible
+
+-- | Llvm Function signature
+llvmFunSig :: LiveGlobalRegs ->  CLabel -> LlvmLinkageType -> LlvmM LlvmFunctionDecl
+llvmFunSig live lbl link = do
+  lbl' <- strCLabel_llvm lbl
+  llvmFunSig' live lbl' link
+
+llvmFunSig' :: LiveGlobalRegs -> LMString -> LlvmLinkageType -> LlvmM LlvmFunctionDecl
+llvmFunSig' live lbl link
+  = do let toParams x | isPointer x = (x, [NoAlias, NoCapture])
+                      | otherwise   = (x, [])
+       dflags <- getDynFlags
+       return $ LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs
+                                 (map (toParams . getVarType) (llvmFunArgs dflags live))
+                                 (llvmFunAlign dflags)
+
+-- | Alignment to use for functions
+llvmFunAlign :: DynFlags -> LMAlign
+llvmFunAlign dflags = Just (wORD_SIZE dflags)
+
+-- | Alignment to use for into tables
+llvmInfAlign :: DynFlags -> LMAlign
+llvmInfAlign dflags = Just (wORD_SIZE dflags)
+
+-- | Section to use for a function
+llvmFunSection :: DynFlags -> LMString -> LMSection
+llvmFunSection dflags lbl
+    | gopt Opt_SplitSections dflags = Just (concatFS [fsLit ".text.", lbl])
+    | otherwise                     = Nothing
+
+-- | A Function's arguments
+llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]
+llvmFunArgs dflags live =
+    map (lmGlobalRegArg dflags) (filter isPassed allRegs)
+    where platform = targetPlatform dflags
+          allRegs = activeStgRegs platform
+          paddedLive = map (\(_,r) -> r) $ padLiveArgs dflags live
+          isLive r = r `elem` alwaysLive || r `elem` paddedLive
+          isPassed r = not (isFPR r) || isLive r
+
+
+isFPR :: GlobalReg -> Bool
+isFPR (FloatReg _)  = True
+isFPR (DoubleReg _) = True
+isFPR (XmmReg _)    = True
+isFPR (YmmReg _)    = True
+isFPR (ZmmReg _)    = True
+isFPR _             = False
+
+sameFPRClass :: GlobalReg -> GlobalReg -> Bool
+sameFPRClass (FloatReg _)  (FloatReg _) = True
+sameFPRClass (DoubleReg _) (DoubleReg _) = True
+sameFPRClass (XmmReg _)    (XmmReg _) = True
+sameFPRClass (YmmReg _)    (YmmReg _) = True
+sameFPRClass (ZmmReg _)    (ZmmReg _) = True
+sameFPRClass _             _          = False
+
+normalizeFPRNum :: GlobalReg -> GlobalReg
+normalizeFPRNum (FloatReg _)  = FloatReg 1
+normalizeFPRNum (DoubleReg _) = DoubleReg 1
+normalizeFPRNum (XmmReg _)    = XmmReg 1
+normalizeFPRNum (YmmReg _)    = YmmReg 1
+normalizeFPRNum (ZmmReg _)    = ZmmReg 1
+normalizeFPRNum _ = error "normalizeFPRNum expected only FPR regs"
+
+getFPRCtor :: GlobalReg -> Int -> GlobalReg
+getFPRCtor (FloatReg _)  = FloatReg
+getFPRCtor (DoubleReg _) = DoubleReg
+getFPRCtor (XmmReg _)    = XmmReg
+getFPRCtor (YmmReg _)    = YmmReg
+getFPRCtor (ZmmReg _)    = ZmmReg
+getFPRCtor _ = error "getFPRCtor expected only FPR regs"
+
+fprRegNum :: GlobalReg -> Int
+fprRegNum (FloatReg i)  = i
+fprRegNum (DoubleReg i) = i
+fprRegNum (XmmReg i)    = i
+fprRegNum (YmmReg i)    = i
+fprRegNum (ZmmReg i)    = i
+fprRegNum _ = error "fprRegNum expected only FPR regs"
+
+-- | Input: dynflags, and the list of live registers
+--
+-- Output: An augmented list of live registers, where padding was
+-- added to the list of registers to ensure the calling convention is
+-- correctly used by LLVM.
+--
+-- Each global reg in the returned list is tagged with a bool, which
+-- indicates whether the global reg was added as padding, or was an original
+-- live register.
+--
+-- That is, True => padding, False => a real, live global register.
+--
+-- Also, the returned list is not sorted in any particular order.
+--
+padLiveArgs :: DynFlags -> LiveGlobalRegs -> [(Bool, GlobalReg)]
+padLiveArgs dflags live =
+      if platformUnregisterised plat
+        then taggedLive -- not using GHC's register convention for platform.
+        else padding ++ taggedLive
+  where
+    taggedLive = map (\x -> (False, x)) live
+    plat = targetPlatform dflags
+
+    fprLive = filter isFPR live
+    padding = concatMap calcPad $ groupBy sharesClass fprLive
+
+    sharesClass :: GlobalReg -> GlobalReg -> Bool
+    sharesClass a b = sameFPRClass a b || overlappingClass
+      where
+        overlappingClass = regsOverlap dflags (norm a) (norm b)
+        norm = CmmGlobal . normalizeFPRNum
+
+    calcPad :: [GlobalReg] -> [(Bool, GlobalReg)]
+    calcPad rs = getFPRPadding (getFPRCtor $ head rs) rs
+
+getFPRPadding :: (Int -> GlobalReg) -> LiveGlobalRegs -> [(Bool, GlobalReg)]
+getFPRPadding paddingCtor live = padding
+    where
+        fprRegNums = sort $ map fprRegNum live
+        (_, padding) = foldl assignSlots (1, []) $ fprRegNums
+
+        assignSlots (i, acc) regNum
+            | i == regNum = -- don't need padding here
+                  (i+1, acc)
+            | i < regNum = let -- add padding for slots i .. regNum-1
+                  numNeeded = regNum-i
+                  acc' = genPad i numNeeded ++ acc
+                in
+                  (regNum+1, acc')
+            | otherwise = error "padLiveArgs -- i > regNum ??"
+
+        genPad start n =
+            take n $ flip map (iterate (+1) start) (\i ->
+                (True, paddingCtor i))
+
+
+-- | Llvm standard fun attributes
+llvmStdFunAttrs :: [LlvmFuncAttr]
+llvmStdFunAttrs = [NoUnwind]
+
+-- | Convert a list of types to a list of function parameters
+-- (each with no parameter attributes)
+tysToParams :: [LlvmType] -> [LlvmParameter]
+tysToParams = map (\ty -> (ty, []))
+
+-- | Pointer width
+llvmPtrBits :: DynFlags -> Int
+llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags
+
+-- ----------------------------------------------------------------------------
+-- * Llvm Version
+--
+
+-- Newtype to avoid using the Eq instance!
+newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int }
+
+parseLlvmVersion :: String -> Maybe LlvmVersion
+parseLlvmVersion =
+    fmap LlvmVersion . NE.nonEmpty . go [] . dropWhile (not . isDigit)
+  where
+    go vs s
+      | null ver_str
+      = reverse vs
+      | '.' : rest' <- rest
+      = go (read ver_str : vs) rest'
+      | otherwise
+      = reverse (read ver_str : vs)
+      where
+        (ver_str, rest) = span isDigit s
+
+-- | The LLVM Version that is currently supported.
+supportedLlvmVersion :: LlvmVersion
+supportedLlvmVersion = LlvmVersion (sUPPORTED_LLVM_VERSION NE.:| [])
+
+llvmVersionSupported :: LlvmVersion -> Bool
+llvmVersionSupported (LlvmVersion v) = NE.head v == sUPPORTED_LLVM_VERSION
+
+llvmVersionStr :: LlvmVersion -> String
+llvmVersionStr = intercalate "." . map show . llvmVersionList
+
+llvmVersionList :: LlvmVersion -> [Int]
+llvmVersionList = NE.toList . llvmVersionNE
+
+-- ----------------------------------------------------------------------------
+-- * Environment Handling
+--
+
+data LlvmEnv = LlvmEnv
+  { envVersion :: LlvmVersion      -- ^ LLVM version
+  , envDynFlags :: DynFlags        -- ^ Dynamic flags
+  , envOutput :: BufHandle         -- ^ Output buffer
+  , envMask :: !Char               -- ^ Mask for creating unique values
+  , 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@)
+
+    -- the following get cleared for every function (see @withClearVars@)
+  , envVarMap :: LlvmEnvMap        -- ^ Local variables so far, with type
+  , envStackRegs :: [GlobalReg]    -- ^ Non-constant registers (alloca'd in the function prelude)
+  }
+
+type LlvmEnvMap = UniqFM LlvmType
+
+-- | The Llvm monad. Wraps @LlvmEnv@ state as well as the @IO@ monad
+newtype LlvmM a = LlvmM { runLlvmM :: LlvmEnv -> IO (a, LlvmEnv) }
+    deriving (Functor)
+
+instance Applicative LlvmM where
+    pure x = LlvmM $ \env -> return (x, env)
+    (<*>) = ap
+
+instance Monad LlvmM where
+    m >>= f  = LlvmM $ \env -> do (x, env') <- runLlvmM m env
+                                  runLlvmM (f x) env'
+
+instance HasDynFlags LlvmM where
+    getDynFlags = LlvmM $ \env -> return (envDynFlags env, env)
+
+instance MonadUnique LlvmM where
+    getUniqueSupplyM = do
+        mask <- getEnv envMask
+        liftIO $! mkSplitUniqSupply mask
+
+    getUniqueM = do
+        mask <- getEnv envMask
+        liftIO $! uniqFromMask mask
+
+-- | Lifting of IO actions. Not exported, as we want to encapsulate IO.
+liftIO :: IO a -> LlvmM a
+liftIO m = LlvmM $ \env -> do x <- m
+                              return (x, env)
+
+-- | Get initial Llvm environment.
+runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a
+runLlvm dflags ver out m = do
+    (a, _) <- runLlvmM m env
+    return a
+  where env = LlvmEnv { envFunMap = emptyUFM
+                      , envVarMap = emptyUFM
+                      , envStackRegs = []
+                      , envUsedVars = []
+                      , envAliases = emptyUniqSet
+                      , envVersion = ver
+                      , envDynFlags = dflags
+                      , envOutput = out
+                      , envMask = 'n'
+                      , envFreshMeta = MetaId 0
+                      , envUniqMeta = emptyUFM
+                      }
+
+-- | Get environment (internal)
+getEnv :: (LlvmEnv -> a) -> LlvmM a
+getEnv f = LlvmM (\env -> return (f env, env))
+
+-- | Modify environment (internal)
+modifyEnv :: (LlvmEnv -> LlvmEnv) -> LlvmM ()
+modifyEnv f = LlvmM (\env -> return ((), f env))
+
+-- | Lift a stream into the LlvmM monad
+liftStream :: Stream.Stream IO a x -> Stream.Stream LlvmM a x
+liftStream s = Stream.Stream $ do
+  r <- liftIO $ Stream.runStream s
+  case r of
+    Left b        -> return (Left b)
+    Right (a, r2) -> return (Right (a, liftStream r2))
+
+-- | Clear variables from the environment for a subcomputation
+withClearVars :: LlvmM a -> LlvmM a
+withClearVars m = LlvmM $ \env -> do
+    (x, env') <- runLlvmM m env { envVarMap = emptyUFM, envStackRegs = [] }
+    return (x, env' { envVarMap = emptyUFM, envStackRegs = [] })
+
+-- | Insert variables or functions into the environment.
+varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmM ()
+varInsert s t = modifyEnv $ \env -> env { envVarMap = addToUFM (envVarMap env) s t }
+funInsert s t = modifyEnv $ \env -> env { envFunMap = addToUFM (envFunMap env) s t }
+
+-- | Lookup variables or functions in the environment.
+varLookup, funLookup :: Uniquable key => key -> LlvmM (Maybe LlvmType)
+varLookup s = getEnv (flip lookupUFM s . envVarMap)
+funLookup s = getEnv (flip lookupUFM s . envFunMap)
+
+-- | Set a register as allocated on the stack
+markStackReg :: GlobalReg -> LlvmM ()
+markStackReg r = modifyEnv $ \env -> env { envStackRegs = r : envStackRegs env }
+
+-- | Check whether a register is allocated on the stack
+checkStackReg :: GlobalReg -> LlvmM Bool
+checkStackReg r = getEnv ((elem r) . envStackRegs)
+
+-- | Allocate a new global unnamed metadata identifier
+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
+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
+  dflags <- getDynFlags
+  liftIO $ dumpIfSet_dyn dflags flag hdr fmt doc
+
+-- | Prints the given contents to the output handle
+renderLlvm :: Outp.SDoc -> LlvmM ()
+renderLlvm sdoc = do
+
+    -- Write to output
+    dflags <- getDynFlags
+    out <- getEnv envOutput
+    liftIO $ Outp.bufLeftRenderSDoc dflags out
+               (Outp.mkCodeStyle Outp.CStyle) sdoc
+
+    -- Dump, if requested
+    dumpIfSetLlvm Opt_D_dump_llvm "LLVM Code" FormatLLVM sdoc
+    return ()
+
+-- | Marks a variable as "used"
+markUsedVar :: LlvmVar -> LlvmM ()
+markUsedVar v = modifyEnv $ \env -> env { envUsedVars = v : envUsedVars env }
+
+-- | Return all variables marked as "used" so far
+getUsedVars :: LlvmM [LlvmVar]
+getUsedVars = getEnv envUsedVars
+
+-- | Saves that at some point we didn't know the type of the label and
+-- generated a reference to a type variable instead
+saveAlias :: LMString -> LlvmM ()
+saveAlias lbl = modifyEnv $ \env -> env { envAliases = addOneToUniqSet (envAliases env) lbl }
+
+-- | Sets metadata node for a given unique
+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 MetaId)
+getUniqMeta s = getEnv (flip lookupUFM s . envUniqMeta)
+
+-- ----------------------------------------------------------------------------
+-- * Internal functions
+--
+
+-- | Here we pre-initialise some functions that are used internally by GHC
+-- so as to make sure they have the most general type in the case that
+-- user code also uses these functions but with a different type than GHC
+-- internally. (Main offender is treating return type as 'void' instead of
+-- 'void *'). Fixes trac #5486.
+ghcInternalFunctions :: LlvmM ()
+ghcInternalFunctions = do
+    dflags <- getDynFlags
+    mk "memcpy" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags]
+    mk "memmove" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags]
+    mk "memset" i8Ptr [i8Ptr, llvmWord dflags, llvmWord dflags]
+    mk "newSpark" (llvmWord dflags) [i8Ptr, i8Ptr]
+  where
+    mk n ret args = do
+      let n' = llvmDefLabel $ fsLit n
+          decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret
+                                 FixedArgs (tysToParams args) Nothing
+      renderLlvm $ ppLlvmFunctionDecl decl
+      funInsert n' (LMFunction decl)
+
+-- ----------------------------------------------------------------------------
+-- * Label handling
+--
+
+-- | Pretty print a 'CLabel'.
+strCLabel_llvm :: CLabel -> LlvmM LMString
+strCLabel_llvm lbl = do
+    dflags <- getDynFlags
+    let sdoc = pprCLabel dflags lbl
+        str = Outp.renderWithStyle dflags sdoc (Outp.mkCodeStyle Outp.CStyle)
+    return (fsLit str)
+
+strDisplayName_llvm :: CLabel -> LlvmM LMString
+strDisplayName_llvm lbl = do
+    dflags <- getDynFlags
+    let sdoc = pprCLabel dflags lbl
+        depth = Outp.PartWay 1
+        style = Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth
+        str = Outp.renderWithStyle dflags sdoc style
+    return (fsLit (dropInfoSuffix str))
+
+dropInfoSuffix :: String -> String
+dropInfoSuffix = go
+  where go "_info"        = []
+        go "_static_info" = []
+        go "_con_info"    = []
+        go (x:xs)         = x:go xs
+        go []             = []
+
+strProcedureName_llvm :: CLabel -> LlvmM LMString
+strProcedureName_llvm lbl = do
+    dflags <- getDynFlags
+    let sdoc = pprCLabel dflags lbl
+        depth = Outp.PartWay 1
+        style = Outp.mkUserStyle dflags Outp.neverQualify depth
+        str = Outp.renderWithStyle dflags sdoc style
+    return (fsLit str)
+
+-- ----------------------------------------------------------------------------
+-- * Global variables / forward references
+--
+
+-- | Create/get a pointer to a global value. Might return an alias if
+-- the value in question hasn't been defined yet. We especially make
+-- no guarantees on the type of the returned pointer.
+getGlobalPtr :: LMString -> LlvmM LlvmVar
+getGlobalPtr llvmLbl = do
+  m_ty <- funLookup llvmLbl
+  let mkGlbVar lbl ty = LMGlobalVar lbl (LMPointer ty) Private Nothing Nothing
+  case m_ty of
+    -- Directly reference if we have seen it already
+    Just ty -> return $ mkGlbVar (llvmDefLabel llvmLbl) ty Global
+    -- Otherwise use a forward alias of it
+    Nothing -> do
+      saveAlias llvmLbl
+      return $ mkGlbVar llvmLbl i8 Alias
+
+-- | Derive the definition label. It has an identified
+-- structure type.
+llvmDefLabel :: LMString -> LMString
+llvmDefLabel = (`appendFS` fsLit "$def")
+
+-- | Generate definitions for aliases forward-referenced by @getGlobalPtr@.
+--
+-- Must be called at a point where we are sure that no new global definitions
+-- will be generated anymore!
+generateExternDecls :: LlvmM ([LMGlobal], [LlvmType])
+generateExternDecls = do
+  delayed <- fmap nonDetEltsUniqSet $ getEnv envAliases
+  -- This is non-deterministic but we do not
+  -- currently support deterministic code-generation.
+  -- See Note [Unique Determinism and code generation]
+  defss <- flip mapM delayed $ \lbl -> do
+    m_ty <- funLookup lbl
+    case m_ty of
+      -- If we have a definition we've already emitted the proper aliases
+      -- when the symbol itself was emitted by @aliasify@
+      Just _ -> return []
+
+      -- If we don't have a definition this is an external symbol and we
+      -- need to emit a declaration
+      Nothing ->
+        let var = LMGlobalVar lbl i8Ptr External Nothing Nothing Global
+        in return [LMGlobal var Nothing]
+
+  -- Reset forward list
+  modifyEnv $ \env -> env { envAliases = emptyUniqSet }
+  return (concat defss, [])
+
+-- | Here we take a global variable definition, rename it with a
+-- @$def@ suffix, and generate the appropriate alias.
+aliasify :: LMGlobal -> LlvmM [LMGlobal]
+-- See note [emit-time elimination of static indirections] in CLabel.
+-- Here we obtain the indirectee's precise type and introduce
+-- fresh aliases to both the precise typed label (lbl$def) and the i8*
+-- typed (regular) label of it with the matching new names.
+aliasify (LMGlobal (LMGlobalVar lbl ty@LMAlias{} link sect align Alias)
+                   (Just orig)) = do
+    let defLbl = llvmDefLabel lbl
+        LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig
+        defOrigLbl = llvmDefLabel origLbl
+        orig' = LMStaticPointer (LMGlobalVar origLbl i8Ptr oLnk Nothing Nothing Alias)
+    origType <- funLookup origLbl
+    let defOrig = LMBitc (LMStaticPointer (LMGlobalVar defOrigLbl
+                                           (pLift $ fromJust origType) oLnk
+                                           Nothing Nothing Alias))
+                         (pLift ty)
+    pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig)
+         , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig')
+         ]
+aliasify (LMGlobal var val) = do
+    let LMGlobalVar lbl ty link sect align const = var
+
+        defLbl = llvmDefLabel lbl
+        defVar = LMGlobalVar defLbl ty Internal sect align const
+
+        defPtrVar = LMGlobalVar defLbl (LMPointer ty) link Nothing Nothing const
+        aliasVar = LMGlobalVar lbl i8Ptr link Nothing Nothing Alias
+        aliasVal = LMBitc (LMStaticPointer defPtrVar) i8Ptr
+
+    -- we need to mark the $def symbols as used so LLVM doesn't forget which
+    -- section they need to go in. This will vanish once we switch away from
+    -- mangling sections for TNTC.
+    markUsedVar defVar
+
+    return [ LMGlobal defVar val
+           , LMGlobal aliasVar (Just aliasVal)
+           ]
+
+-- Note [Llvm Forward References]
+--
+-- The issue here is that LLVM insists on being strongly typed at
+-- every corner, so the first time we mention something, we have to
+-- settle what type we assign to it. That makes things awkward, as Cmm
+-- will often reference things before their definition, and we have no
+-- idea what (LLVM) type it is going to be before that point.
+--
+-- Our work-around is to define "aliases" of a standard type (i8 *) in
+-- these kind of situations, which we later tell LLVM to be either
+-- references to their actual local definitions (involving a cast) or
+-- an external reference. This obviously only works for pointers.
+--
+-- In particular when we encounter a reference to a symbol in a chunk of
+-- C-- there are three possible scenarios,
+--
+--   1. We have already seen a definition for the referenced symbol. This
+--      means we already know its type.
+--
+--   2. We have not yet seen a definition but we will find one later in this
+--      compilation unit. Since we want to be a good consumer of the
+--      C-- streamed to us from upstream, we don't know the type of the
+--      symbol at the time when we must emit the reference.
+--
+--   3. We have not yet seen a definition nor will we find one in this
+--      compilation unit. In this case the reference refers to an
+--      external symbol for which we do not know the type.
+--
+-- Let's consider case (2) for a moment: say we see a reference to
+-- the symbol @fooBar@ for which we have not seen a definition. As we
+-- do not know the symbol's type, we assume it is of type @i8*@ and emit
+-- the appropriate casts in @getSymbolPtr@. Later on, when we
+-- encounter the definition of @fooBar@ we emit it but with a modified
+-- name, @fooBar$def@ (which we'll call the definition symbol), to
+-- since we have already had to assume that the symbol @fooBar@
+-- is of type @i8*@. We then emit @fooBar@ itself as an alias
+-- of @fooBar$def@ with appropriate casts. This all happens in
+-- @aliasify@.
+--
+-- Case (3) is quite similar to (2): References are emitted assuming
+-- the referenced symbol is of type @i8*@. When we arrive at the end of
+-- the compilation unit and realize that the symbol is external, we emit
+-- an LLVM @external global@ declaration for the symbol @fooBar@
+-- (handled in @generateExternDecls@). This takes advantage of the
+-- fact that the aliases produced by @aliasify@ for exported symbols
+-- have external linkage and can therefore be used as normal symbols.
+--
+-- Historical note: As of release 3.5 LLVM does not allow aliases to
+-- refer to declarations. This the reason why aliases are produced at the
+-- point of definition instead of the point of usage, as was previously
+-- done. See #9142 for details.
+--
+-- Finally, case (1) is trivial. As we already have a definition for
+-- and therefore know the type of the referenced symbol, we can do
+-- away with casting the alias to the desired type in @getSymbolPtr@
+-- and instead just emit a reference to the definition symbol directly.
+-- This is the @Just@ case in @getSymbolPtr@.
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
new file mode 100644
index 0000000000..33dd82c418
--- /dev/null
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -0,0 +1,1995 @@
+{-# LANGUAGE CPP, GADTs #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+-- ----------------------------------------------------------------------------
+-- | Handle conversion of CmmProc to LLVM code.
+--
+module GHC.CmmToLlvm.CodeGen ( genLlvmProc ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Llvm
+import GHC.CmmToLlvm.Base
+import GHC.CmmToLlvm.Regs
+
+import GHC.Cmm.BlockId
+import GHC.Platform.Regs ( activeStgRegs )
+import GHC.Cmm.CLabel
+import GHC.Cmm
+import GHC.Cmm.Ppr as PprCmm
+import GHC.Cmm.Utils
+import GHC.Cmm.Switch
+import GHC.Cmm.Dataflow.Block
+import GHC.Cmm.Dataflow.Graph
+import GHC.Cmm.Dataflow.Collections
+
+import DynFlags
+import FastString
+import ForeignCall
+import Outputable hiding (panic, pprPanic)
+import qualified Outputable
+import GHC.Platform
+import OrdList
+import UniqSupply
+import Unique
+import Util
+
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Writer
+
+import qualified Data.Semigroup as Semigroup
+import Data.List ( nub )
+import Data.Maybe ( catMaybes )
+
+type Atomic = Bool
+type LlvmStatements = OrdList LlvmStatement
+
+data Signage = Signed | Unsigned deriving (Eq, Show)
+
+-- -----------------------------------------------------------------------------
+-- | Top-level of the LLVM proc Code generator
+--
+genLlvmProc :: RawCmmDecl -> LlvmM [LlvmCmmDecl]
+genLlvmProc (CmmProc infos lbl live graph) = do
+    let blocks = toBlockListEntryFirstFalseFallthrough graph
+    (lmblocks, lmdata) <- basicBlocksCodeGen live blocks
+    let info = mapLookup (g_entry graph) infos
+        proc = CmmProc info lbl live (ListGraph lmblocks)
+    return (proc:lmdata)
+
+genLlvmProc _ = panic "genLlvmProc: case that shouldn't reach here!"
+
+-- -----------------------------------------------------------------------------
+-- * Block code generation
+--
+
+-- | Generate code for a list of blocks that make up a complete
+-- procedure. The first block in the list is expected to be the entry
+-- point.
+basicBlocksCodeGen :: LiveGlobalRegs -> [CmmBlock]
+                      -> LlvmM ([LlvmBasicBlock], [LlvmCmmDecl])
+basicBlocksCodeGen _    []                     = panic "no entry block!"
+basicBlocksCodeGen live cmmBlocks
+  = do -- Emit the prologue
+       -- N.B. this must be its own block to ensure that the entry block of the
+       -- procedure has no predecessors, as required by the LLVM IR. See #17589
+       -- and #11649.
+       bid <- newBlockId
+       (prologue, prologueTops) <- funPrologue live cmmBlocks
+       let entryBlock = BasicBlock bid (fromOL prologue)
+
+       -- Generate code
+       (blocks, topss) <- fmap unzip $ mapM basicBlockCodeGen cmmBlocks
+
+       -- Compose
+       return (entryBlock : blocks, prologueTops ++ concat topss)
+
+
+-- | Generate code for one block
+basicBlockCodeGen :: CmmBlock -> LlvmM ( LlvmBasicBlock, [LlvmCmmDecl] )
+basicBlockCodeGen block
+  = do let (_, nodes, tail)  = blockSplit block
+           id = entryLabel block
+       (mid_instrs, top) <- stmtsToInstrs $ blockToList nodes
+       (tail_instrs, top')  <- stmtToInstrs tail
+       let instrs = fromOL (mid_instrs `appOL` tail_instrs)
+       return (BasicBlock id instrs, top' ++ top)
+
+-- -----------------------------------------------------------------------------
+-- * CmmNode code generation
+--
+
+-- A statement conversion return data.
+--   * LlvmStatements: The compiled LLVM statements.
+--   * LlvmCmmDecl: Any global data needed.
+type StmtData = (LlvmStatements, [LlvmCmmDecl])
+
+
+-- | Convert a list of CmmNode's to LlvmStatement's
+stmtsToInstrs :: [CmmNode e x] -> LlvmM StmtData
+stmtsToInstrs stmts
+   = do (instrss, topss) <- fmap unzip $ mapM stmtToInstrs stmts
+        return (concatOL instrss, concat topss)
+
+
+-- | Convert a CmmStmt to a list of LlvmStatement's
+stmtToInstrs :: CmmNode e x -> LlvmM StmtData
+stmtToInstrs stmt = case stmt of
+
+    CmmComment _         -> return (nilOL, []) -- nuke comments
+    CmmTick    _         -> return (nilOL, [])
+    CmmUnwind  {}        -> return (nilOL, [])
+
+    CmmAssign reg src    -> genAssign reg src
+    CmmStore addr src    -> genStore addr src
+
+    CmmBranch id         -> genBranch id
+    CmmCondBranch arg true false likely
+                         -> genCondBranch arg true false likely
+    CmmSwitch arg ids    -> genSwitch arg ids
+
+    -- Foreign Call
+    CmmUnsafeForeignCall target res args
+        -> genCall target res args
+
+    -- Tail call
+    CmmCall { cml_target = arg,
+              cml_args_regs = live } -> genJump arg live
+
+    _ -> panic "Llvm.CodeGen.stmtToInstrs"
+
+-- | Wrapper function to declare an instrinct function by function type
+getInstrinct2 :: LMString -> LlvmType -> LlvmM ExprData
+getInstrinct2 fname fty@(LMFunction funSig) = do
+
+    let fv   = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing Constant
+
+    fn <- funLookup fname
+    tops <- case fn of
+      Just _  ->
+        return []
+      Nothing -> do
+        funInsert fname fty
+        un <- getUniqueM
+        let lbl = mkAsmTempLabel un
+        return [CmmData (Section Data lbl) [([],[fty])]]
+
+    return (fv, nilOL, tops)
+
+getInstrinct2 _ _ = error "getInstrinct2: Non-function type!"
+
+-- | Declares an instrinct function by return and parameter types
+getInstrinct :: LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData
+getInstrinct fname retTy parTys =
+    let funSig = LlvmFunctionDecl fname ExternallyVisible CC_Ccc retTy
+                    FixedArgs (tysToParams parTys) Nothing
+        fty = LMFunction funSig
+    in getInstrinct2 fname fty
+
+-- | Memory barrier instruction for LLVM >= 3.0
+barrier :: LlvmM StmtData
+barrier = do
+    let s = Fence False SyncSeqCst
+    return (unitOL s, [])
+
+-- | Insert a 'barrier', unless the target platform is in the provided list of
+--   exceptions (where no code will be emitted instead).
+barrierUnless :: [Arch] -> LlvmM StmtData
+barrierUnless exs = do
+    platform <- getLlvmPlatform
+    if platformArch platform `elem` exs
+        then return (nilOL, [])
+        else barrier
+
+-- | Foreign Calls
+genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual]
+              -> LlvmM StmtData
+
+-- Barriers need to be handled specially as they are implemented as LLVM
+-- intrinsic functions.
+genCall (PrimTarget MO_ReadBarrier) _ _ =
+    barrierUnless [ArchX86, ArchX86_64, ArchSPARC]
+genCall (PrimTarget MO_WriteBarrier) _ _ = do
+    barrierUnless [ArchX86, ArchX86_64, ArchSPARC]
+
+genCall (PrimTarget MO_Touch) _ _
+ = return (nilOL, [])
+
+genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do
+    dstV <- getCmmRegW (CmmLocal dst)
+    let ty = cmmToLlvmType $ localRegType dst
+        width = widthToLlvmFloat w
+    castV <- lift $ mkLocalVar ty
+    ve <- exprToVarW e
+    statement $ Assignment castV $ Cast LM_Uitofp ve width
+    statement $ Store castV dstV
+
+genCall (PrimTarget (MO_UF_Conv _)) [_] args =
+    panic $ "genCall: Too many arguments to MO_UF_Conv. " ++
+    "Can only handle 1, given" ++ show (length args) ++ "."
+
+-- Handle prefetching data
+genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args
+  | 0 <= localityInt && localityInt <= 3 = runStmtsDecls $ do
+    let argTy = [i8Ptr, i32, i32, i32]
+        funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible
+                             CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing
+
+    let (_, arg_hints) = foreignTargetHints t
+    let args_hints' = zip args arg_hints
+    argVars <- arg_varsW args_hints' ([], nilOL, [])
+    fptr    <- liftExprData $ getFunPtr funTy t
+    argVars' <- castVarsW Signed $ zip argVars argTy
+
+    let argSuffix = [mkIntLit i32 0, mkIntLit i32 localityInt, mkIntLit i32 1]
+    statement $ Expr $ Call StdCall fptr (argVars' ++ argSuffix) []
+  | otherwise = panic $ "prefetch locality level integer must be between 0 and 3, given: " ++ (show localityInt)
+
+-- Handle PopCnt, Clz, Ctz, and BSwap that need to only convert arg
+-- and return types
+genCall t@(PrimTarget (MO_PopCnt w)) dsts args =
+    genCallSimpleCast w t dsts args
+
+genCall t@(PrimTarget (MO_Pdep w)) dsts args =
+    genCallSimpleCast2 w t dsts args
+genCall t@(PrimTarget (MO_Pext w)) dsts args =
+    genCallSimpleCast2 w t dsts args
+genCall t@(PrimTarget (MO_Clz w)) dsts args =
+    genCallSimpleCast w t dsts args
+genCall t@(PrimTarget (MO_Ctz w)) dsts args =
+    genCallSimpleCast w t dsts args
+genCall t@(PrimTarget (MO_BSwap w)) dsts args =
+    genCallSimpleCast w t dsts args
+genCall t@(PrimTarget (MO_BRev w)) dsts args =
+    genCallSimpleCast w t dsts args
+
+genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do
+    addrVar <- exprToVarW addr
+    nVar <- exprToVarW n
+    let targetTy = widthToLlvmInt width
+        ptrExpr = Cast LM_Inttoptr addrVar (pLift targetTy)
+    ptrVar <- doExprW (pLift targetTy) ptrExpr
+    dstVar <- getCmmRegW (CmmLocal dst)
+    let op = case amop of
+               AMO_Add  -> LAO_Add
+               AMO_Sub  -> LAO_Sub
+               AMO_And  -> LAO_And
+               AMO_Nand -> LAO_Nand
+               AMO_Or   -> LAO_Or
+               AMO_Xor  -> LAO_Xor
+    retVar <- doExprW targetTy $ AtomicRMW op ptrVar nVar SyncSeqCst
+    statement $ Store retVar dstVar
+
+genCall (PrimTarget (MO_AtomicRead _)) [dst] [addr] = runStmtsDecls $ do
+    dstV <- getCmmRegW (CmmLocal dst)
+    v1 <- genLoadW True addr (localRegType dst)
+    statement $ Store v1 dstV
+
+genCall (PrimTarget (MO_Cmpxchg _width))
+        [dst] [addr, old, new] = runStmtsDecls $ do
+    addrVar <- exprToVarW addr
+    oldVar <- exprToVarW old
+    newVar <- exprToVarW new
+    let targetTy = getVarType oldVar
+        ptrExpr = Cast LM_Inttoptr addrVar (pLift targetTy)
+    ptrVar <- doExprW (pLift targetTy) ptrExpr
+    dstVar <- getCmmRegW (CmmLocal dst)
+    retVar <- doExprW (LMStructU [targetTy,i1])
+              $ CmpXChg ptrVar oldVar newVar SyncSeqCst SyncSeqCst
+    retVar' <- doExprW targetTy $ ExtractV retVar 0
+    statement $ Store retVar' dstVar
+
+genCall (PrimTarget (MO_AtomicWrite _width)) [] [addr, val] = runStmtsDecls $ do
+    addrVar <- exprToVarW addr
+    valVar <- exprToVarW val
+    let ptrTy = pLift $ getVarType valVar
+        ptrExpr = Cast LM_Inttoptr addrVar ptrTy
+    ptrVar <- doExprW ptrTy ptrExpr
+    statement $ Expr $ AtomicRMW LAO_Xchg ptrVar valVar SyncSeqCst
+
+-- Handle memcpy function specifically since llvm's intrinsic version takes
+-- some extra parameters.
+genCall t@(PrimTarget op) [] args
+ | Just align <- machOpMemcpyishAlign op = runStmtsDecls $ do
+    dflags <- getDynFlags
+    let isVolTy = [i1]
+        isVolVal = [mkIntLit i1 0]
+        argTy | MO_Memset _ <- op = [i8Ptr, i8,    llvmWord dflags, i32] ++ isVolTy
+              | otherwise         = [i8Ptr, i8Ptr, llvmWord dflags, i32] ++ isVolTy
+        funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible
+                             CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing
+
+    let (_, arg_hints) = foreignTargetHints t
+    let args_hints = zip args arg_hints
+    argVars       <- arg_varsW args_hints ([], nilOL, [])
+    fptr          <- getFunPtrW funTy t
+    argVars' <- castVarsW Signed $ zip argVars argTy
+
+    let alignVal = mkIntLit i32 align
+        arguments = argVars' ++ (alignVal:isVolVal)
+    statement $ Expr $ Call StdCall fptr arguments []
+
+-- We handle MO_U_Mul2 by simply using a 'mul' instruction, but with operands
+-- twice the width (we first zero-extend them), e.g., on 64-bit arch we will
+-- generate 'mul' on 128-bit operands. Then we only need some plumbing to
+-- extract the two 64-bit values out of 128-bit result.
+genCall (PrimTarget (MO_U_Mul2 w)) [dstH, dstL] [lhs, rhs] = runStmtsDecls $ do
+    let width = widthToLlvmInt w
+        bitWidth = widthInBits w
+        width2x = LMInt (bitWidth * 2)
+    -- First zero-extend the operands ('mul' instruction requires the operands
+    -- and the result to be of the same type). Note that we don't use 'castVars'
+    -- because it tries to do LM_Sext.
+    lhsVar <- exprToVarW lhs
+    rhsVar <- exprToVarW rhs
+    lhsExt <- doExprW width2x $ Cast LM_Zext lhsVar width2x
+    rhsExt <- doExprW width2x $ Cast LM_Zext rhsVar width2x
+    -- Do the actual multiplication (note that the result is also 2x width).
+    retV <- doExprW width2x $ LlvmOp LM_MO_Mul lhsExt rhsExt
+    -- Extract the lower bits of the result into retL.
+    retL <- doExprW width $ Cast LM_Trunc retV width
+    -- Now we right-shift the higher bits by width.
+    let widthLlvmLit = LMLitVar $ LMIntLit (fromIntegral bitWidth) width
+    retShifted <- doExprW width2x $ LlvmOp LM_MO_LShr retV widthLlvmLit
+    -- And extract them into retH.
+    retH <- doExprW width $ Cast LM_Trunc retShifted width
+    dstRegL <- getCmmRegW (CmmLocal dstL)
+    dstRegH <- getCmmRegW (CmmLocal dstH)
+    statement $ Store retL dstRegL
+    statement $ Store retH dstRegH
+
+-- MO_U_QuotRem2 is another case we handle by widening the registers to double
+-- the width and use normal LLVM instructions (similarly to the MO_U_Mul2). The
+-- main difference here is that we need to combine two words into one register
+-- and then use both 'udiv' and 'urem' instructions to compute the result.
+genCall (PrimTarget (MO_U_QuotRem2 w))
+        [dstQ, dstR] [lhsH, lhsL, rhs] = runStmtsDecls $ do
+    let width = widthToLlvmInt w
+        bitWidth = widthInBits w
+        width2x = LMInt (bitWidth * 2)
+    -- First zero-extend all parameters to double width.
+    let zeroExtend expr = do
+            var <- exprToVarW expr
+            doExprW width2x $ Cast LM_Zext var width2x
+    lhsExtH <- zeroExtend lhsH
+    lhsExtL <- zeroExtend lhsL
+    rhsExt <- zeroExtend rhs
+    -- Now we combine the first two parameters (that represent the high and low
+    -- bits of the value). So first left-shift the high bits to their position
+    -- and then bit-or them with the low bits.
+    let widthLlvmLit = LMLitVar $ LMIntLit (fromIntegral bitWidth) width
+    lhsExtHShifted <- doExprW width2x $ LlvmOp LM_MO_Shl lhsExtH widthLlvmLit
+    lhsExt <- doExprW width2x $ LlvmOp LM_MO_Or lhsExtHShifted lhsExtL
+    -- Finally, we can call 'udiv' and 'urem' to compute the results.
+    retExtDiv <- doExprW width2x $ LlvmOp LM_MO_UDiv lhsExt rhsExt
+    retExtRem <- doExprW width2x $ LlvmOp LM_MO_URem lhsExt rhsExt
+    -- And since everything is in 2x width, we need to truncate the results and
+    -- then return them.
+    let narrow var = doExprW width $ Cast LM_Trunc var width
+    retDiv <- narrow retExtDiv
+    retRem <- narrow retExtRem
+    dstRegQ <- lift $ getCmmReg (CmmLocal dstQ)
+    dstRegR <- lift $ getCmmReg (CmmLocal dstR)
+    statement $ Store retDiv dstRegQ
+    statement $ Store retRem dstRegR
+
+-- Handle the MO_{Add,Sub}IntC separately. LLVM versions return a record from
+-- which we need to extract the actual values.
+genCall t@(PrimTarget (MO_AddIntC w)) [dstV, dstO] [lhs, rhs] =
+    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]
+genCall t@(PrimTarget (MO_SubIntC w)) [dstV, dstO] [lhs, rhs] =
+    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]
+
+-- Similar to MO_{Add,Sub}IntC, but MO_Add2 expects the first element of the
+-- return tuple to be the overflow bit and the second element to contain the
+-- actual result of the addition. So we still use genCallWithOverflow but swap
+-- the return registers.
+genCall t@(PrimTarget (MO_Add2 w)) [dstO, dstV] [lhs, rhs] =
+    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]
+
+genCall t@(PrimTarget (MO_AddWordC w)) [dstV, dstO] [lhs, rhs] =
+    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]
+
+genCall t@(PrimTarget (MO_SubWordC w)) [dstV, dstO] [lhs, rhs] =
+    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]
+
+-- Handle all other foreign calls and prim ops.
+genCall target res args = runStmtsDecls $ do
+    dflags <- getDynFlags
+
+    -- parameter types
+    let arg_type (_, AddrHint) = i8Ptr
+        -- cast pointers to i8*. Llvm equivalent of void*
+        arg_type (expr, _) = cmmToLlvmType $ cmmExprType dflags expr
+
+    -- ret type
+    let ret_type [] = LMVoid
+        ret_type [(_, AddrHint)] = i8Ptr
+        ret_type [(reg, _)]      = cmmToLlvmType $ localRegType reg
+        ret_type t = panic $ "genCall: Too many return values! Can only handle"
+                        ++ " 0 or 1, given " ++ show (length t) ++ "."
+
+    -- extract Cmm call convention, and translate to LLVM call convention
+    platform <- lift $ getLlvmPlatform
+    let lmconv = case target of
+            ForeignTarget _ (ForeignConvention conv _ _ _) ->
+              case conv of
+                 StdCallConv  -> case platformArch platform of
+                                 ArchX86    -> CC_X86_Stdcc
+                                 ArchX86_64 -> CC_X86_Stdcc
+                                 _          -> CC_Ccc
+                 CCallConv    -> CC_Ccc
+                 CApiConv     -> CC_Ccc
+                 PrimCallConv       -> panic "GHC.CmmToLlvm.CodeGen.genCall: PrimCallConv"
+                 JavaScriptCallConv -> panic "GHC.CmmToLlvm.CodeGen.genCall: JavaScriptCallConv"
+
+            PrimTarget   _ -> CC_Ccc
+
+    {-
+        CC_Ccc of the possibilities here are a worry with the use of a custom
+        calling convention for passing STG args. In practice the more
+        dangerous combinations (e.g StdCall + llvmGhcCC) don't occur.
+
+        The native code generator only handles StdCall and CCallConv.
+    -}
+
+    -- call attributes
+    let fnAttrs | never_returns = NoReturn : llvmStdFunAttrs
+                | otherwise     = llvmStdFunAttrs
+
+        never_returns = case target of
+             ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns) -> True
+             _ -> False
+
+    -- fun type
+    let (res_hints, arg_hints) = foreignTargetHints target
+    let args_hints = zip args arg_hints
+    let ress_hints = zip res  res_hints
+    let ccTy  = StdCall -- tail calls should be done through CmmJump
+    let retTy = ret_type ress_hints
+    let argTy = tysToParams $ map arg_type args_hints
+    let funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible
+                             lmconv retTy FixedArgs argTy (llvmFunAlign dflags)
+
+
+    argVars <- arg_varsW args_hints ([], nilOL, [])
+    fptr    <- getFunPtrW funTy target
+
+    let doReturn | ccTy == TailCall  = statement $ Return Nothing
+                 | never_returns     = statement $ Unreachable
+                 | otherwise         = return ()
+
+
+    -- make the actual call
+    case retTy of
+        LMVoid -> do
+            statement $ Expr $ Call ccTy fptr argVars fnAttrs
+
+        _ -> do
+            v1 <- doExprW retTy $ Call ccTy fptr argVars fnAttrs
+            -- get the return register
+            let ret_reg [reg] = reg
+                ret_reg t = panic $ "genCall: Bad number of registers! Can only handle"
+                                ++ " 1, given " ++ show (length t) ++ "."
+            let creg = ret_reg res
+            vreg <- getCmmRegW (CmmLocal creg)
+            if retTy == pLower (getVarType vreg)
+                then do
+                    statement $ Store v1 vreg
+                    doReturn
+                else do
+                    let ty = pLower $ getVarType vreg
+                    let op = case ty of
+                            vt | isPointer vt -> LM_Bitcast
+                               | isInt     vt -> LM_Ptrtoint
+                               | otherwise    ->
+                                   panic $ "genCall: CmmReg bad match for"
+                                        ++ " returned type!"
+
+                    v2 <- doExprW ty $ Cast op v1 ty
+                    statement $ Store v2 vreg
+                    doReturn
+
+-- | Generate a call to an LLVM intrinsic that performs arithmetic operation
+-- with overflow bit (i.e., returns a struct containing the actual result of the
+-- operation and an overflow bit). This function will also extract the overflow
+-- bit and zero-extend it (all the corresponding Cmm PrimOps represent the
+-- overflow "bit" as a usual Int# or Word#).
+genCallWithOverflow
+  :: ForeignTarget -> Width -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData
+genCallWithOverflow t@(PrimTarget op) w [dstV, dstO] [lhs, rhs] = do
+    -- So far this was only tested for the following four CallishMachOps.
+    let valid = op `elem`   [ MO_Add2 w
+                            , MO_AddIntC w
+                            , MO_SubIntC w
+                            , MO_AddWordC w
+                            , MO_SubWordC w
+                            ]
+    MASSERT(valid)
+    let width = widthToLlvmInt w
+    -- This will do most of the work of generating the call to the intrinsic and
+    -- extracting the values from the struct.
+    (value, overflowBit, (stmts, top)) <-
+      genCallExtract t w (lhs, rhs) (width, i1)
+    -- value is i<width>, but overflowBit is i1, so we need to cast (Cmm expects
+    -- both to be i<width>)
+    (overflow, zext) <- doExpr width $ Cast LM_Zext overflowBit width
+    dstRegV <- getCmmReg (CmmLocal dstV)
+    dstRegO <- getCmmReg (CmmLocal dstO)
+    let storeV = Store value dstRegV
+        storeO = Store overflow dstRegO
+    return (stmts `snocOL` zext `snocOL` storeV `snocOL` storeO, top)
+genCallWithOverflow _ _ _ _ =
+    panic "genCallExtract: wrong ForeignTarget or number of arguments"
+
+-- | A helper function for genCallWithOverflow that handles generating the call
+-- to the LLVM intrinsic and extracting the result from the struct to LlvmVars.
+genCallExtract
+    :: ForeignTarget           -- ^ PrimOp
+    -> Width                   -- ^ Width of the operands.
+    -> (CmmActual, CmmActual)  -- ^ Actual arguments.
+    -> (LlvmType, LlvmType)    -- ^ LLVM types of the returned struct.
+    -> LlvmM (LlvmVar, LlvmVar, StmtData)
+genCallExtract target@(PrimTarget op) w (argA, argB) (llvmTypeA, llvmTypeB) = do
+    let width = widthToLlvmInt w
+        argTy = [width, width]
+        retTy = LMStructU [llvmTypeA, llvmTypeB]
+
+    -- Process the arguments.
+    let args_hints = zip [argA, argB] (snd $ foreignTargetHints target)
+    (argsV1, args1, top1) <- arg_vars args_hints ([], nilOL, [])
+    (argsV2, args2) <- castVars Signed $ zip argsV1 argTy
+
+    -- Get the function and make the call.
+    fname <- cmmPrimOpFunctions op
+    (fptr, _, top2) <- getInstrinct fname retTy argTy
+    -- We use StdCall for primops. See also the last case of genCall.
+    (retV, call) <- doExpr retTy $ Call StdCall fptr argsV2 []
+
+    -- This will result in a two element struct, we need to use "extractvalue"
+    -- to get them out of it.
+    (res1, ext1) <- doExpr llvmTypeA (ExtractV retV 0)
+    (res2, ext2) <- doExpr llvmTypeB (ExtractV retV 1)
+
+    let stmts = args1 `appOL` args2 `snocOL` call `snocOL` ext1 `snocOL` ext2
+        tops = top1 ++ top2
+    return (res1, res2, (stmts, tops))
+
+genCallExtract _ _ _ _ =
+    panic "genCallExtract: unsupported ForeignTarget"
+
+-- Handle simple function call that only need simple type casting, of the form:
+--   truncate arg >>= \a -> call(a) >>= zext
+--
+-- since GHC only really has i32 and i64 types and things like Word8 are backed
+-- by an i32 and just present a logical i8 range. So we must handle conversions
+-- from i32 to i8 explicitly as LLVM is strict about types.
+genCallSimpleCast :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]
+              -> LlvmM StmtData
+genCallSimpleCast w t@(PrimTarget op) [dst] args = do
+    let width = widthToLlvmInt w
+        dstTy = cmmToLlvmType $ localRegType dst
+
+    fname                       <- cmmPrimOpFunctions op
+    (fptr, _, top3)             <- getInstrinct fname width [width]
+
+    dstV                        <- getCmmReg (CmmLocal dst)
+
+    let (_, arg_hints) = foreignTargetHints t
+    let args_hints = zip args arg_hints
+    (argsV, stmts2, top2)       <- arg_vars args_hints ([], nilOL, [])
+    (argsV', stmts4)            <- castVars Signed $ zip argsV [width]
+    (retV, s1)                  <- doExpr width $ Call StdCall fptr argsV' []
+    (retVs', stmts5)            <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]
+    let retV'                    = singletonPanic "genCallSimpleCast" retVs'
+    let s2                       = Store retV' dstV
+
+    let stmts = stmts2 `appOL` stmts4 `snocOL`
+                s1 `appOL` stmts5 `snocOL` s2
+    return (stmts, top2 ++ top3)
+genCallSimpleCast _ _ dsts _ =
+    panic ("genCallSimpleCast: " ++ show (length dsts) ++ " dsts")
+
+-- Handle simple function call that only need simple type casting, of the form:
+--   truncate arg >>= \a -> call(a) >>= zext
+--
+-- since GHC only really has i32 and i64 types and things like Word8 are backed
+-- by an i32 and just present a logical i8 range. So we must handle conversions
+-- from i32 to i8 explicitly as LLVM is strict about types.
+genCallSimpleCast2 :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]
+              -> LlvmM StmtData
+genCallSimpleCast2 w t@(PrimTarget op) [dst] args = do
+    let width = widthToLlvmInt w
+        dstTy = cmmToLlvmType $ localRegType dst
+
+    fname                       <- cmmPrimOpFunctions op
+    (fptr, _, top3)             <- getInstrinct fname width (const width <$> args)
+
+    dstV                        <- getCmmReg (CmmLocal dst)
+
+    let (_, arg_hints) = foreignTargetHints t
+    let args_hints = zip args arg_hints
+    (argsV, stmts2, top2)       <- arg_vars args_hints ([], nilOL, [])
+    (argsV', stmts4)            <- castVars Signed $ zip argsV (const width <$> argsV)
+    (retV, s1)                  <- doExpr width $ Call StdCall fptr argsV' []
+    (retVs', stmts5)             <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]
+    let retV'                    = singletonPanic "genCallSimpleCast2" retVs'
+    let s2                       = Store retV' dstV
+
+    let stmts = stmts2 `appOL` stmts4 `snocOL`
+                s1 `appOL` stmts5 `snocOL` s2
+    return (stmts, top2 ++ top3)
+genCallSimpleCast2 _ _ dsts _ =
+    panic ("genCallSimpleCast2: " ++ show (length dsts) ++ " dsts")
+
+-- | Create a function pointer from a target.
+getFunPtrW :: (LMString -> LlvmType) -> ForeignTarget
+           -> WriterT LlvmAccum LlvmM LlvmVar
+getFunPtrW funTy targ = liftExprData $ getFunPtr funTy targ
+
+-- | Create a function pointer from a target.
+getFunPtr :: (LMString -> LlvmType) -> ForeignTarget
+          -> LlvmM ExprData
+getFunPtr funTy targ = case targ of
+    ForeignTarget (CmmLit (CmmLabel lbl)) _ -> do
+        name <- strCLabel_llvm lbl
+        getHsFunc' name (funTy name)
+
+    ForeignTarget expr _ -> do
+        (v1, stmts, top) <- exprToVar expr
+        dflags <- getDynFlags
+        let fty = funTy $ fsLit "dynamic"
+            cast = case getVarType v1 of
+                ty | isPointer ty -> LM_Bitcast
+                ty | isInt ty     -> LM_Inttoptr
+
+                ty -> panic $ "genCall: Expr is of bad type for function"
+                              ++ " call! (" ++ showSDoc dflags (ppr ty) ++ ")"
+
+        (v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)
+        return (v2, stmts `snocOL` s1, top)
+
+    PrimTarget mop -> do
+        name <- cmmPrimOpFunctions mop
+        let fty = funTy name
+        getInstrinct2 name fty
+
+-- | Conversion of call arguments.
+arg_varsW :: [(CmmActual, ForeignHint)]
+          -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
+          -> WriterT LlvmAccum LlvmM [LlvmVar]
+arg_varsW xs ys = do
+    (vars, stmts, decls) <- lift $ arg_vars xs ys
+    tell $ LlvmAccum stmts decls
+    return vars
+
+-- | Conversion of call arguments.
+arg_vars :: [(CmmActual, ForeignHint)]
+         -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
+         -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
+
+arg_vars [] (vars, stmts, tops)
+  = return (vars, stmts, tops)
+
+arg_vars ((e, AddrHint):rest) (vars, stmts, tops)
+  = do (v1, stmts', top') <- exprToVar e
+       dflags <- getDynFlags
+       let op = case getVarType v1 of
+               ty | isPointer ty -> LM_Bitcast
+               ty | isInt ty     -> LM_Inttoptr
+
+               a  -> panic $ "genCall: Can't cast llvmType to i8*! ("
+                           ++ showSDoc dflags (ppr a) ++ ")"
+
+       (v2, s1) <- doExpr i8Ptr $ Cast op v1 i8Ptr
+       arg_vars rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1,
+                               tops ++ top')
+
+arg_vars ((e, _):rest) (vars, stmts, tops)
+  = do (v1, stmts', top') <- exprToVar e
+       arg_vars rest (vars ++ [v1], stmts `appOL` stmts', tops ++ top')
+
+
+-- | Cast a collection of LLVM variables to specific types.
+castVarsW :: Signage
+          -> [(LlvmVar, LlvmType)]
+          -> WriterT LlvmAccum LlvmM [LlvmVar]
+castVarsW signage vars = do
+    (vars, stmts) <- lift $ castVars signage vars
+    tell $ LlvmAccum stmts mempty
+    return vars
+
+-- | Cast a collection of LLVM variables to specific types.
+castVars :: Signage -> [(LlvmVar, LlvmType)]
+         -> LlvmM ([LlvmVar], LlvmStatements)
+castVars signage vars = do
+                done <- mapM (uncurry (castVar signage)) vars
+                let (vars', stmts) = unzip done
+                return (vars', toOL stmts)
+
+-- | Cast an LLVM variable to a specific type, panicing if it can't be done.
+castVar :: Signage -> LlvmVar -> LlvmType -> LlvmM (LlvmVar, LlvmStatement)
+castVar signage v t | getVarType v == t
+            = return (v, Nop)
+
+            | otherwise
+            = do dflags <- getDynFlags
+                 let op = case (getVarType v, t) of
+                      (LMInt n, LMInt m)
+                          -> if n < m then extend else LM_Trunc
+                      (vt, _) | isFloat vt && isFloat t
+                          -> if llvmWidthInBits dflags vt < llvmWidthInBits dflags t
+                                then LM_Fpext else LM_Fptrunc
+                      (vt, _) | isInt vt && isFloat t       -> LM_Sitofp
+                      (vt, _) | isFloat vt && isInt t       -> LM_Fptosi
+                      (vt, _) | isInt vt && isPointer t     -> LM_Inttoptr
+                      (vt, _) | isPointer vt && isInt t     -> LM_Ptrtoint
+                      (vt, _) | isPointer vt && isPointer t -> LM_Bitcast
+                      (vt, _) | isVector vt && isVector t   -> LM_Bitcast
+
+                      (vt, _) -> panic $ "castVars: Can't cast this type ("
+                                  ++ showSDoc dflags (ppr vt) ++ ") to (" ++ showSDoc dflags (ppr t) ++ ")"
+                 doExpr t $ Cast op v t
+    where extend = case signage of
+            Signed      -> LM_Sext
+            Unsigned    -> LM_Zext
+
+
+cmmPrimOpRetValSignage :: CallishMachOp -> Signage
+cmmPrimOpRetValSignage mop = case mop of
+    MO_Pdep _   -> Unsigned
+    MO_Pext _   -> Unsigned
+    _           -> Signed
+
+-- | Decide what C function to use to implement a CallishMachOp
+cmmPrimOpFunctions :: CallishMachOp -> LlvmM LMString
+cmmPrimOpFunctions mop = do
+
+  dflags <- getDynFlags
+  let intrinTy1 = "p0i8.p0i8." ++ showSDoc dflags (ppr $ llvmWord dflags)
+      intrinTy2 = "p0i8." ++ showSDoc dflags (ppr $ llvmWord dflags)
+      unsupported = panic ("cmmPrimOpFunctions: " ++ show mop
+                        ++ " not supported here")
+
+  return $ case mop of
+    MO_F32_Exp    -> fsLit "expf"
+    MO_F32_ExpM1  -> fsLit "expm1f"
+    MO_F32_Log    -> fsLit "logf"
+    MO_F32_Log1P  -> fsLit "log1pf"
+    MO_F32_Sqrt   -> fsLit "llvm.sqrt.f32"
+    MO_F32_Fabs   -> fsLit "llvm.fabs.f32"
+    MO_F32_Pwr    -> fsLit "llvm.pow.f32"
+
+    MO_F32_Sin    -> fsLit "llvm.sin.f32"
+    MO_F32_Cos    -> fsLit "llvm.cos.f32"
+    MO_F32_Tan    -> fsLit "tanf"
+
+    MO_F32_Asin   -> fsLit "asinf"
+    MO_F32_Acos   -> fsLit "acosf"
+    MO_F32_Atan   -> fsLit "atanf"
+
+    MO_F32_Sinh   -> fsLit "sinhf"
+    MO_F32_Cosh   -> fsLit "coshf"
+    MO_F32_Tanh   -> fsLit "tanhf"
+
+    MO_F32_Asinh  -> fsLit "asinhf"
+    MO_F32_Acosh  -> fsLit "acoshf"
+    MO_F32_Atanh  -> fsLit "atanhf"
+
+    MO_F64_Exp    -> fsLit "exp"
+    MO_F64_ExpM1  -> fsLit "expm1"
+    MO_F64_Log    -> fsLit "log"
+    MO_F64_Log1P  -> fsLit "log1p"
+    MO_F64_Sqrt   -> fsLit "llvm.sqrt.f64"
+    MO_F64_Fabs   -> fsLit "llvm.fabs.f64"
+    MO_F64_Pwr    -> fsLit "llvm.pow.f64"
+
+    MO_F64_Sin    -> fsLit "llvm.sin.f64"
+    MO_F64_Cos    -> fsLit "llvm.cos.f64"
+    MO_F64_Tan    -> fsLit "tan"
+
+    MO_F64_Asin   -> fsLit "asin"
+    MO_F64_Acos   -> fsLit "acos"
+    MO_F64_Atan   -> fsLit "atan"
+
+    MO_F64_Sinh   -> fsLit "sinh"
+    MO_F64_Cosh   -> fsLit "cosh"
+    MO_F64_Tanh   -> fsLit "tanh"
+
+    MO_F64_Asinh  -> fsLit "asinh"
+    MO_F64_Acosh  -> fsLit "acosh"
+    MO_F64_Atanh  -> fsLit "atanh"
+
+    MO_Memcpy _   -> fsLit $ "llvm.memcpy."  ++ intrinTy1
+    MO_Memmove _  -> fsLit $ "llvm.memmove." ++ intrinTy1
+    MO_Memset _   -> fsLit $ "llvm.memset."  ++ intrinTy2
+    MO_Memcmp _   -> fsLit $ "memcmp"
+
+    (MO_PopCnt w) -> fsLit $ "llvm.ctpop."      ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_BSwap w)  -> fsLit $ "llvm.bswap."      ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_BRev w)   -> fsLit $ "llvm.bitreverse." ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_Clz w)    -> fsLit $ "llvm.ctlz."       ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_Ctz w)    -> fsLit $ "llvm.cttz."       ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+
+    (MO_Pdep w)   ->  let w' = showSDoc dflags (ppr $ widthInBits w)
+                      in  if isBmi2Enabled dflags
+                            then fsLit $ "llvm.x86.bmi.pdep."   ++ w'
+                            else fsLit $ "hs_pdep"              ++ w'
+    (MO_Pext w)   ->  let w' = showSDoc dflags (ppr $ widthInBits w)
+                      in  if isBmi2Enabled dflags
+                            then fsLit $ "llvm.x86.bmi.pext."   ++ w'
+                            else fsLit $ "hs_pext"              ++ w'
+
+    (MO_Prefetch_Data _ )-> fsLit "llvm.prefetch"
+
+    MO_AddIntC w    -> fsLit $ "llvm.sadd.with.overflow."
+                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    MO_SubIntC w    -> fsLit $ "llvm.ssub.with.overflow."
+                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    MO_Add2 w       -> fsLit $ "llvm.uadd.with.overflow."
+                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    MO_AddWordC w   -> fsLit $ "llvm.uadd.with.overflow."
+                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    MO_SubWordC w   -> fsLit $ "llvm.usub.with.overflow."
+                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+
+    MO_S_Mul2    {}  -> unsupported
+    MO_S_QuotRem {}  -> unsupported
+    MO_U_QuotRem {}  -> unsupported
+    MO_U_QuotRem2 {} -> unsupported
+    -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the
+    -- appropriate case of genCall.
+    MO_U_Mul2 {}     -> unsupported
+    MO_ReadBarrier   -> unsupported
+    MO_WriteBarrier  -> unsupported
+    MO_Touch         -> unsupported
+    MO_UF_Conv _     -> unsupported
+
+    MO_AtomicRead _  -> unsupported
+    MO_AtomicRMW _ _ -> unsupported
+    MO_AtomicWrite _ -> unsupported
+    MO_Cmpxchg _     -> unsupported
+
+-- | Tail function calls
+genJump :: CmmExpr -> [GlobalReg] -> LlvmM StmtData
+
+-- Call to known function
+genJump (CmmLit (CmmLabel lbl)) live = do
+    (vf, stmts, top) <- getHsFunc live lbl
+    (stgRegs, stgStmts) <- funEpilogue live
+    let s1  = Expr $ Call TailCall vf stgRegs llvmStdFunAttrs
+    let s2  = Return Nothing
+    return (stmts `appOL` stgStmts `snocOL` s1 `snocOL` s2, top)
+
+
+-- Call to unknown function / address
+genJump expr live = do
+    fty <- llvmFunTy live
+    (vf, stmts, top) <- exprToVar expr
+    dflags <- getDynFlags
+
+    let cast = case getVarType vf of
+         ty | isPointer ty -> LM_Bitcast
+         ty | isInt ty     -> LM_Inttoptr
+
+         ty -> panic $ "genJump: Expr is of bad type for function call! ("
+                     ++ showSDoc dflags (ppr ty) ++ ")"
+
+    (v1, s1) <- doExpr (pLift fty) $ Cast cast vf (pLift fty)
+    (stgRegs, stgStmts) <- funEpilogue live
+    let s2 = Expr $ Call TailCall v1 stgRegs llvmStdFunAttrs
+    let s3 = Return Nothing
+    return (stmts `snocOL` s1 `appOL` stgStmts `snocOL` s2 `snocOL` s3,
+            top)
+
+
+-- | CmmAssign operation
+--
+-- We use stack allocated variables for CmmReg. The optimiser will replace
+-- these with registers when possible.
+genAssign :: CmmReg -> CmmExpr -> LlvmM StmtData
+genAssign reg val = do
+    vreg <- getCmmReg reg
+    (vval, stmts2, top2) <- exprToVar val
+    let stmts = stmts2
+
+    let ty = (pLower . getVarType) vreg
+    dflags <- getDynFlags
+    case ty of
+      -- Some registers are pointer types, so need to cast value to pointer
+      LMPointer _ | getVarType vval == llvmWord dflags -> do
+          (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty
+          let s2 = Store v vreg
+          return (stmts `snocOL` s1 `snocOL` s2, top2)
+
+      LMVector _ _ -> do
+          (v, s1) <- doExpr ty $ Cast LM_Bitcast vval ty
+          let s2 = Store v vreg
+          return (stmts `snocOL` s1 `snocOL` s2, top2)
+
+      _ -> do
+          let s1 = Store vval vreg
+          return (stmts `snocOL` s1, top2)
+
+
+-- | CmmStore operation
+genStore :: CmmExpr -> CmmExpr -> LlvmM StmtData
+
+-- First we try to detect a few common cases and produce better code for
+-- these then the default case. We are mostly trying to detect Cmm code
+-- like I32[Sp + n] and use 'getelementptr' operations instead of the
+-- generic case that uses casts and pointer arithmetic
+genStore addr@(CmmReg (CmmGlobal r)) val
+    = genStore_fast addr r 0 val
+
+genStore addr@(CmmRegOff (CmmGlobal r) n) val
+    = genStore_fast addr r n val
+
+genStore addr@(CmmMachOp (MO_Add _) [
+                            (CmmReg (CmmGlobal r)),
+                            (CmmLit (CmmInt n _))])
+                val
+    = genStore_fast addr r (fromInteger n) val
+
+genStore addr@(CmmMachOp (MO_Sub _) [
+                            (CmmReg (CmmGlobal r)),
+                            (CmmLit (CmmInt n _))])
+                val
+    = genStore_fast addr r (negate $ fromInteger n) val
+
+-- generic case
+genStore addr val
+    = getTBAAMeta topN >>= genStore_slow addr val
+
+-- | CmmStore operation
+-- This is a special case for storing to a global register pointer
+-- offset such as I32[Sp+8].
+genStore_fast :: CmmExpr -> GlobalReg -> Int -> CmmExpr
+              -> LlvmM StmtData
+genStore_fast addr r n val
+  = do dflags <- getDynFlags
+       (gv, grt, s1) <- getCmmRegVal (CmmGlobal r)
+       meta          <- getTBAARegMeta r
+       let (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)
+       case isPointer grt && rem == 0 of
+            True -> do
+                (vval,  stmts, top) <- exprToVar val
+                (ptr, s2) <- doExpr grt $ GetElemPtr True gv [toI32 ix]
+                -- We might need a different pointer type, so check
+                case pLower grt == getVarType vval of
+                     -- were fine
+                     True  -> do
+                         let s3 = MetaStmt meta $ Store vval ptr
+                         return (stmts `appOL` s1 `snocOL` s2
+                                 `snocOL` s3, top)
+
+                     -- cast to pointer type needed
+                     False -> do
+                         let ty = (pLift . getVarType) vval
+                         (ptr', s3) <- doExpr ty $ Cast LM_Bitcast ptr ty
+                         let s4 = MetaStmt meta $ Store vval ptr'
+                         return (stmts `appOL` s1 `snocOL` s2
+                                 `snocOL` s3 `snocOL` s4, top)
+
+            -- If its a bit type then we use the slow method since
+            -- we can't avoid casting anyway.
+            False -> genStore_slow addr val meta
+
+
+-- | CmmStore operation
+-- Generic case. Uses casts and pointer arithmetic if needed.
+genStore_slow :: CmmExpr -> CmmExpr -> [MetaAnnot] -> LlvmM StmtData
+genStore_slow addr val meta = do
+    (vaddr, stmts1, top1) <- exprToVar addr
+    (vval,  stmts2, top2) <- exprToVar val
+
+    let stmts = stmts1 `appOL` stmts2
+    dflags <- getDynFlags
+    case getVarType vaddr of
+        -- sometimes we need to cast an int to a pointer before storing
+        LMPointer ty@(LMPointer _) | getVarType vval == llvmWord dflags -> do
+            (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty
+            let s2 = MetaStmt meta $ Store v vaddr
+            return (stmts `snocOL` s1 `snocOL` s2, top1 ++ top2)
+
+        LMPointer _ -> do
+            let s1 = MetaStmt meta $ Store vval vaddr
+            return (stmts `snocOL` s1, top1 ++ top2)
+
+        i@(LMInt _) | i == llvmWord dflags -> do
+            let vty = pLift $ getVarType vval
+            (vptr, s1) <- doExpr vty $ Cast LM_Inttoptr vaddr vty
+            let s2 = MetaStmt meta $ Store vval vptr
+            return (stmts `snocOL` s1 `snocOL` s2, top1 ++ top2)
+
+        other ->
+            pprPanic "genStore: ptr not right type!"
+                    (PprCmm.pprExpr addr <+> text (
+                        "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
+                        ", Size of var: " ++ show (llvmWidthInBits dflags other) ++
+                        ", Var: " ++ showSDoc dflags (ppr vaddr)))
+
+
+-- | Unconditional branch
+genBranch :: BlockId -> LlvmM StmtData
+genBranch id =
+    let label = blockIdToLlvm id
+    in return (unitOL $ Branch label, [])
+
+
+-- | Conditional branch
+genCondBranch :: CmmExpr -> BlockId -> BlockId -> Maybe Bool -> LlvmM StmtData
+genCondBranch cond idT idF likely = do
+    let labelT = blockIdToLlvm idT
+    let labelF = blockIdToLlvm idF
+    -- See Note [Literals and branch conditions].
+    (vc, stmts1, top1) <- exprToVarOpt i1Option cond
+    if getVarType vc == i1
+        then do
+            (vc', (stmts2, top2)) <- case likely of
+              Just b -> genExpectLit (if b then 1 else 0) i1  vc
+              _      -> pure (vc, (nilOL, []))
+            let s1 = BranchIf vc' labelT labelF
+            return (stmts1 `appOL` stmts2 `snocOL` s1, top1 ++ top2)
+        else do
+            dflags <- getDynFlags
+            panic $ "genCondBranch: Cond expr not bool! (" ++ showSDoc dflags (ppr vc) ++ ")"
+
+
+-- | Generate call to llvm.expect.x intrinsic. Assigning result to a new var.
+genExpectLit :: Integer -> LlvmType -> LlvmVar -> LlvmM (LlvmVar, StmtData)
+genExpectLit expLit expTy var = do
+  dflags <- getDynFlags
+
+  let
+    lit = LMLitVar $ LMIntLit expLit expTy
+
+    llvmExpectName
+      | isInt expTy = fsLit $ "llvm.expect." ++ showSDoc dflags (ppr expTy)
+      | otherwise   = panic $ "genExpectedLit: Type not an int!"
+
+  (llvmExpect, stmts, top) <-
+    getInstrinct llvmExpectName expTy [expTy, expTy]
+  (var', call) <- doExpr expTy $ Call StdCall llvmExpect [var, lit] []
+  return (var', (stmts `snocOL` call, top))
+
+{- Note [Literals and branch conditions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+It is important that whenever we generate branch conditions for
+literals like '1', they are properly narrowed to an LLVM expression of
+type 'i1' (for bools.) Otherwise, nobody is happy. So when we convert
+a CmmExpr to an LLVM expression for a branch conditional, exprToVarOpt
+must be certain to return a properly narrowed type. genLit is
+responsible for this, in the case of literal integers.
+
+Often, we won't see direct statements like:
+
+    if(1) {
+      ...
+    } else {
+      ...
+    }
+
+at this point in the pipeline, because the Glorious Code Generator
+will do trivial branch elimination in the sinking pass (among others,)
+which will eliminate the expression entirely.
+
+However, it's certainly possible and reasonable for this to occur in
+hand-written C-- code. Consider something like:
+
+    #if !defined(SOME_CONDITIONAL)
+    #define CHECK_THING(x) 1
+    #else
+    #define CHECK_THING(x) some_operation((x))
+    #endif
+
+    f() {
+
+      if (CHECK_THING(xyz)) {
+        ...
+      } else {
+        ...
+      }
+
+    }
+
+In such an instance, CHECK_THING might result in an *expression* in
+one case, and a *literal* in the other, depending on what in
+particular was #define'd. So we must be sure to properly narrow the
+literal in this case to i1 as it won't be eliminated beforehand.
+
+For a real example of this, see ./rts/StgStdThunks.cmm
+
+-}
+
+
+
+-- | Switch branch
+genSwitch :: CmmExpr -> SwitchTargets -> LlvmM StmtData
+genSwitch cond ids = do
+    (vc, stmts, top) <- exprToVar cond
+    let ty = getVarType vc
+
+    let labels = [ (mkIntLit ty ix, blockIdToLlvm b)
+                 | (ix, b) <- switchTargetsCases ids ]
+    -- out of range is undefined, so let's just branch to first label
+    let defLbl | Just l <- switchTargetsDefault ids = blockIdToLlvm l
+               | otherwise                          = snd (head labels)
+
+    let s1 = Switch vc defLbl labels
+    return $ (stmts `snocOL` s1, top)
+
+
+-- -----------------------------------------------------------------------------
+-- * CmmExpr code generation
+--
+
+-- | An expression conversion return data:
+--   * LlvmVar: The var holding the result of the expression
+--   * LlvmStatements: Any statements needed to evaluate the expression
+--   * LlvmCmmDecl: Any global data needed for this expression
+type ExprData = (LlvmVar, LlvmStatements, [LlvmCmmDecl])
+
+-- | Values which can be passed to 'exprToVar' to configure its
+-- behaviour in certain circumstances.
+--
+-- Currently just used for determining if a comparison should return
+-- a boolean (i1) or a word. See Note [Literals and branch conditions].
+newtype EOption = EOption { i1Expected :: Bool }
+-- XXX: EOption is an ugly and inefficient solution to this problem.
+
+-- | i1 type expected (condition scrutinee).
+i1Option :: EOption
+i1Option = EOption True
+
+-- | Word type expected (usual).
+wordOption :: EOption
+wordOption = EOption False
+
+-- | Convert a CmmExpr to a list of LlvmStatements with the result of the
+-- expression being stored in the returned LlvmVar.
+exprToVar :: CmmExpr -> LlvmM ExprData
+exprToVar = exprToVarOpt wordOption
+
+exprToVarOpt :: EOption -> CmmExpr -> LlvmM ExprData
+exprToVarOpt opt e = case e of
+
+    CmmLit lit
+        -> genLit opt lit
+
+    CmmLoad e' ty
+        -> genLoad False e' ty
+
+    -- Cmmreg in expression is the value, so must load. If you want actual
+    -- reg pointer, call getCmmReg directly.
+    CmmReg r -> do
+        (v1, ty, s1) <- getCmmRegVal r
+        case isPointer ty of
+             True  -> do
+                 -- Cmm wants the value, so pointer types must be cast to ints
+                 dflags <- getDynFlags
+                 (v2, s2) <- doExpr (llvmWord dflags) $ Cast LM_Ptrtoint v1 (llvmWord dflags)
+                 return (v2, s1 `snocOL` s2, [])
+
+             False -> return (v1, s1, [])
+
+    CmmMachOp op exprs
+        -> genMachOp opt op exprs
+
+    CmmRegOff r i
+        -> do dflags <- getDynFlags
+              exprToVar $ expandCmmReg dflags (r, i)
+
+    CmmStackSlot _ _
+        -> panic "exprToVar: CmmStackSlot not supported!"
+
+
+-- | Handle CmmMachOp expressions
+genMachOp :: EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData
+
+-- Unary Machop
+genMachOp _ op [x] = case op of
+
+    MO_Not w ->
+        let all1 = mkIntLit (widthToLlvmInt w) (-1)
+        in negate (widthToLlvmInt w) all1 LM_MO_Xor
+
+    MO_S_Neg w ->
+        let all0 = mkIntLit (widthToLlvmInt w) 0
+        in negate (widthToLlvmInt w) all0 LM_MO_Sub
+
+    MO_F_Neg w ->
+        let all0 = LMLitVar $ LMFloatLit (-0) (widthToLlvmFloat w)
+        in negate (widthToLlvmFloat w) all0 LM_MO_FSub
+
+    MO_SF_Conv _ w -> fiConv (widthToLlvmFloat w) LM_Sitofp
+    MO_FS_Conv _ w -> fiConv (widthToLlvmInt w) LM_Fptosi
+
+    MO_SS_Conv from to
+        -> sameConv from (widthToLlvmInt to) LM_Trunc LM_Sext
+
+    MO_UU_Conv from to
+        -> sameConv from (widthToLlvmInt to) LM_Trunc LM_Zext
+
+    MO_XX_Conv from to
+        -> sameConv from (widthToLlvmInt to) LM_Trunc LM_Zext
+
+    MO_FF_Conv from to
+        -> sameConv from (widthToLlvmFloat to) LM_Fptrunc LM_Fpext
+
+    MO_VS_Neg len w ->
+        let ty    = widthToLlvmInt w
+            vecty = LMVector len ty
+            all0  = LMIntLit (-0) ty
+            all0s = LMLitVar $ LMVectorLit (replicate len all0)
+        in negateVec vecty all0s LM_MO_Sub
+
+    MO_VF_Neg len w ->
+        let ty    = widthToLlvmFloat w
+            vecty = LMVector len ty
+            all0  = LMFloatLit (-0) ty
+            all0s = LMLitVar $ LMVectorLit (replicate len all0)
+        in negateVec vecty all0s LM_MO_FSub
+
+    MO_AlignmentCheck _ _ -> panic "-falignment-sanitisation is not supported by -fllvm"
+
+    -- Handle unsupported cases explicitly so we get a warning
+    -- of missing case when new MachOps added
+    MO_Add _          -> panicOp
+    MO_Mul _          -> panicOp
+    MO_Sub _          -> panicOp
+    MO_S_MulMayOflo _ -> panicOp
+    MO_S_Quot _       -> panicOp
+    MO_S_Rem _        -> panicOp
+    MO_U_MulMayOflo _ -> panicOp
+    MO_U_Quot _       -> panicOp
+    MO_U_Rem _        -> panicOp
+
+    MO_Eq  _          -> panicOp
+    MO_Ne  _          -> panicOp
+    MO_S_Ge _         -> panicOp
+    MO_S_Gt _         -> panicOp
+    MO_S_Le _         -> panicOp
+    MO_S_Lt _         -> panicOp
+    MO_U_Ge _         -> panicOp
+    MO_U_Gt _         -> panicOp
+    MO_U_Le _         -> panicOp
+    MO_U_Lt _         -> panicOp
+
+    MO_F_Add        _ -> panicOp
+    MO_F_Sub        _ -> panicOp
+    MO_F_Mul        _ -> panicOp
+    MO_F_Quot       _ -> panicOp
+    MO_F_Eq         _ -> panicOp
+    MO_F_Ne         _ -> panicOp
+    MO_F_Ge         _ -> panicOp
+    MO_F_Gt         _ -> panicOp
+    MO_F_Le         _ -> panicOp
+    MO_F_Lt         _ -> panicOp
+
+    MO_And          _ -> panicOp
+    MO_Or           _ -> panicOp
+    MO_Xor          _ -> panicOp
+    MO_Shl          _ -> panicOp
+    MO_U_Shr        _ -> panicOp
+    MO_S_Shr        _ -> panicOp
+
+    MO_V_Insert   _ _ -> panicOp
+    MO_V_Extract  _ _ -> panicOp
+
+    MO_V_Add      _ _ -> panicOp
+    MO_V_Sub      _ _ -> panicOp
+    MO_V_Mul      _ _ -> panicOp
+
+    MO_VS_Quot    _ _ -> panicOp
+    MO_VS_Rem     _ _ -> panicOp
+
+    MO_VU_Quot    _ _ -> panicOp
+    MO_VU_Rem     _ _ -> panicOp
+
+    MO_VF_Insert  _ _ -> panicOp
+    MO_VF_Extract _ _ -> panicOp
+
+    MO_VF_Add     _ _ -> panicOp
+    MO_VF_Sub     _ _ -> panicOp
+    MO_VF_Mul     _ _ -> panicOp
+    MO_VF_Quot    _ _ -> panicOp
+
+    where
+        negate ty v2 negOp = do
+            (vx, stmts, top) <- exprToVar x
+            (v1, s1) <- doExpr ty $ LlvmOp negOp v2 vx
+            return (v1, stmts `snocOL` s1, top)
+
+        negateVec ty v2 negOp = do
+            (vx, stmts1, top) <- exprToVar x
+            (vxs', stmts2) <- castVars Signed [(vx, ty)]
+            let vx' = singletonPanic "genMachOp: negateVec" vxs'
+            (v1, s1) <- doExpr ty $ LlvmOp negOp v2 vx'
+            return (v1, stmts1 `appOL` stmts2 `snocOL` s1, top)
+
+        fiConv ty convOp = do
+            (vx, stmts, top) <- exprToVar x
+            (v1, s1) <- doExpr ty $ Cast convOp vx ty
+            return (v1, stmts `snocOL` s1, top)
+
+        sameConv from ty reduce expand = do
+            x'@(vx, stmts, top) <- exprToVar x
+            let sameConv' op = do
+                    (v1, s1) <- doExpr ty $ Cast op vx ty
+                    return (v1, stmts `snocOL` s1, top)
+            dflags <- getDynFlags
+            let toWidth = llvmWidthInBits dflags ty
+            -- LLVM doesn't like trying to convert to same width, so
+            -- need to check for that as we do get Cmm code doing it.
+            case widthInBits from  of
+                 w | w < toWidth -> sameConv' expand
+                 w | w > toWidth -> sameConv' reduce
+                 _w              -> return x'
+
+        panicOp = panic $ "LLVM.CodeGen.genMachOp: non unary op encountered"
+                       ++ "with one argument! (" ++ show op ++ ")"
+
+-- Handle GlobalRegs pointers
+genMachOp opt o@(MO_Add _) e@[(CmmReg (CmmGlobal r)), (CmmLit (CmmInt n _))]
+    = genMachOp_fast opt o r (fromInteger n) e
+
+genMachOp opt o@(MO_Sub _) e@[(CmmReg (CmmGlobal r)), (CmmLit (CmmInt n _))]
+    = genMachOp_fast opt o r (negate . fromInteger $ n) e
+
+-- Generic case
+genMachOp opt op e = genMachOp_slow opt op e
+
+
+-- | Handle CmmMachOp expressions
+-- This is a specialised method that handles Global register manipulations like
+-- 'Sp - 16', using the getelementptr instruction.
+genMachOp_fast :: EOption -> MachOp -> GlobalReg -> Int -> [CmmExpr]
+               -> LlvmM ExprData
+genMachOp_fast opt op r n e
+  = do (gv, grt, s1) <- getCmmRegVal (CmmGlobal r)
+       dflags <- getDynFlags
+       let (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)
+       case isPointer grt && rem == 0 of
+            True -> do
+                (ptr, s2) <- doExpr grt $ GetElemPtr True gv [toI32 ix]
+                (var, s3) <- doExpr (llvmWord dflags) $ Cast LM_Ptrtoint ptr (llvmWord dflags)
+                return (var, s1 `snocOL` s2 `snocOL` s3, [])
+
+            False -> genMachOp_slow opt op e
+
+
+-- | Handle CmmMachOp expressions
+-- This handles all the cases not handle by the specialised genMachOp_fast.
+genMachOp_slow :: EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData
+
+-- Element extraction
+genMachOp_slow _ (MO_V_Extract l w) [val, idx] = runExprData $ do
+    vval <- exprToVarW val
+    vidx <- exprToVarW idx
+    vval' <- singletonPanic "genMachOp_slow" <$>
+             castVarsW Signed [(vval, LMVector l ty)]
+    doExprW ty $ Extract vval' vidx
+  where
+    ty = widthToLlvmInt w
+
+genMachOp_slow _ (MO_VF_Extract l w) [val, idx] = runExprData $ do
+    vval <- exprToVarW val
+    vidx <- exprToVarW idx
+    vval' <- singletonPanic "genMachOp_slow" <$>
+             castVarsW Signed [(vval, LMVector l ty)]
+    doExprW ty $ Extract vval' vidx
+  where
+    ty = widthToLlvmFloat w
+
+-- Element insertion
+genMachOp_slow _ (MO_V_Insert l w) [val, elt, idx] = runExprData $ do
+    vval <- exprToVarW val
+    velt <- exprToVarW elt
+    vidx <- exprToVarW idx
+    vval' <- singletonPanic "genMachOp_slow" <$>
+             castVarsW Signed [(vval, ty)]
+    doExprW ty $ Insert vval' velt vidx
+  where
+    ty = LMVector l (widthToLlvmInt w)
+
+genMachOp_slow _ (MO_VF_Insert l w) [val, elt, idx] = runExprData $ do
+    vval <- exprToVarW val
+    velt <- exprToVarW elt
+    vidx <- exprToVarW idx
+    vval' <- singletonPanic "genMachOp_slow" <$>
+             castVarsW Signed [(vval, ty)]
+    doExprW ty $ Insert vval' velt vidx
+  where
+    ty = LMVector l (widthToLlvmFloat w)
+
+-- Binary MachOp
+genMachOp_slow opt op [x, y] = case op of
+
+    MO_Eq _   -> genBinComp opt LM_CMP_Eq
+    MO_Ne _   -> genBinComp opt LM_CMP_Ne
+
+    MO_S_Gt _ -> genBinComp opt LM_CMP_Sgt
+    MO_S_Ge _ -> genBinComp opt LM_CMP_Sge
+    MO_S_Lt _ -> genBinComp opt LM_CMP_Slt
+    MO_S_Le _ -> genBinComp opt LM_CMP_Sle
+
+    MO_U_Gt _ -> genBinComp opt LM_CMP_Ugt
+    MO_U_Ge _ -> genBinComp opt LM_CMP_Uge
+    MO_U_Lt _ -> genBinComp opt LM_CMP_Ult
+    MO_U_Le _ -> genBinComp opt LM_CMP_Ule
+
+    MO_Add _ -> genBinMach LM_MO_Add
+    MO_Sub _ -> genBinMach LM_MO_Sub
+    MO_Mul _ -> genBinMach LM_MO_Mul
+
+    MO_U_MulMayOflo _ -> panic "genMachOp: MO_U_MulMayOflo unsupported!"
+
+    MO_S_MulMayOflo w -> isSMulOK w x y
+
+    MO_S_Quot _ -> genBinMach LM_MO_SDiv
+    MO_S_Rem  _ -> genBinMach LM_MO_SRem
+
+    MO_U_Quot _ -> genBinMach LM_MO_UDiv
+    MO_U_Rem  _ -> genBinMach LM_MO_URem
+
+    MO_F_Eq _ -> genBinComp opt LM_CMP_Feq
+    MO_F_Ne _ -> genBinComp opt LM_CMP_Fne
+    MO_F_Gt _ -> genBinComp opt LM_CMP_Fgt
+    MO_F_Ge _ -> genBinComp opt LM_CMP_Fge
+    MO_F_Lt _ -> genBinComp opt LM_CMP_Flt
+    MO_F_Le _ -> genBinComp opt LM_CMP_Fle
+
+    MO_F_Add  _ -> genBinMach LM_MO_FAdd
+    MO_F_Sub  _ -> genBinMach LM_MO_FSub
+    MO_F_Mul  _ -> genBinMach LM_MO_FMul
+    MO_F_Quot _ -> genBinMach LM_MO_FDiv
+
+    MO_And _   -> genBinMach LM_MO_And
+    MO_Or  _   -> genBinMach LM_MO_Or
+    MO_Xor _   -> genBinMach LM_MO_Xor
+    MO_Shl _   -> genBinMach LM_MO_Shl
+    MO_U_Shr _ -> genBinMach LM_MO_LShr
+    MO_S_Shr _ -> genBinMach LM_MO_AShr
+
+    MO_V_Add l w   -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Add
+    MO_V_Sub l w   -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Sub
+    MO_V_Mul l w   -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Mul
+
+    MO_VS_Quot l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_SDiv
+    MO_VS_Rem  l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_SRem
+
+    MO_VU_Quot l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_UDiv
+    MO_VU_Rem  l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_URem
+
+    MO_VF_Add  l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FAdd
+    MO_VF_Sub  l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FSub
+    MO_VF_Mul  l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FMul
+    MO_VF_Quot l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FDiv
+
+    MO_Not _       -> panicOp
+    MO_S_Neg _     -> panicOp
+    MO_F_Neg _     -> panicOp
+
+    MO_SF_Conv _ _ -> panicOp
+    MO_FS_Conv _ _ -> panicOp
+    MO_SS_Conv _ _ -> panicOp
+    MO_UU_Conv _ _ -> panicOp
+    MO_XX_Conv _ _ -> panicOp
+    MO_FF_Conv _ _ -> panicOp
+
+    MO_V_Insert  {} -> panicOp
+    MO_V_Extract {} -> panicOp
+
+    MO_VS_Neg {} -> panicOp
+
+    MO_VF_Insert  {} -> panicOp
+    MO_VF_Extract {} -> panicOp
+
+    MO_VF_Neg {} -> panicOp
+
+    MO_AlignmentCheck {} -> panicOp
+
+    where
+        binLlvmOp ty binOp = runExprData $ do
+            vx <- exprToVarW x
+            vy <- exprToVarW y
+            if getVarType vx == getVarType vy
+                then do
+                    doExprW (ty vx) $ binOp vx vy
+
+                else do
+                    -- Error. Continue anyway so we can debug the generated ll file.
+                    dflags <- getDynFlags
+                    let style = mkCodeStyle CStyle
+                        toString doc = renderWithStyle dflags doc style
+                        cmmToStr = (lines . toString . PprCmm.pprExpr)
+                    statement $ Comment $ map fsLit $ cmmToStr x
+                    statement $ Comment $ map fsLit $ cmmToStr y
+                    doExprW (ty vx) $ binOp vx vy
+
+        binCastLlvmOp ty binOp = runExprData $ do
+            vx <- exprToVarW x
+            vy <- exprToVarW y
+            vxy' <- castVarsW Signed [(vx, ty), (vy, ty)]
+            case vxy' of
+              [vx',vy'] -> doExprW ty $ binOp vx' vy'
+              _         -> panic "genMachOp_slow: binCastLlvmOp"
+
+        -- | Need to use EOption here as Cmm expects word size results from
+        -- comparisons while LLVM return i1. Need to extend to llvmWord type
+        -- if expected. See Note [Literals and branch conditions].
+        genBinComp opt cmp = do
+            ed@(v1, stmts, top) <- binLlvmOp (\_ -> i1) (Compare cmp)
+            dflags <- getDynFlags
+            if getVarType v1 == i1
+                then case i1Expected opt of
+                    True  -> return ed
+                    False -> do
+                        let w_ = llvmWord dflags
+                        (v2, s1) <- doExpr w_ $ Cast LM_Zext v1 w_
+                        return (v2, stmts `snocOL` s1, top)
+                else
+                    panic $ "genBinComp: Compare returned type other then i1! "
+                        ++ (showSDoc dflags $ ppr $ getVarType v1)
+
+        genBinMach op = binLlvmOp getVarType (LlvmOp op)
+
+        genCastBinMach ty op = binCastLlvmOp ty (LlvmOp op)
+
+        -- | Detect if overflow will occur in signed multiply of the two
+        -- CmmExpr's. This is the LLVM assembly equivalent of the NCG
+        -- implementation. Its much longer due to type information/safety.
+        -- This should actually compile to only about 3 asm instructions.
+        isSMulOK :: Width -> CmmExpr -> CmmExpr -> LlvmM ExprData
+        isSMulOK _ x y = runExprData $ do
+            vx <- exprToVarW x
+            vy <- exprToVarW y
+
+            dflags <- getDynFlags
+            let word  = getVarType vx
+            let word2 = LMInt $ 2 * (llvmWidthInBits dflags $ getVarType vx)
+            let shift = llvmWidthInBits dflags word
+            let shift1 = toIWord dflags (shift - 1)
+            let shift2 = toIWord dflags shift
+
+            if isInt word
+                then do
+                    x1     <- doExprW word2 $ Cast LM_Sext vx word2
+                    y1     <- doExprW word2 $ Cast LM_Sext vy word2
+                    r1     <- doExprW word2 $ LlvmOp LM_MO_Mul x1 y1
+                    rlow1  <- doExprW word $ Cast LM_Trunc r1 word
+                    rlow2  <- doExprW word $ LlvmOp LM_MO_AShr rlow1 shift1
+                    rhigh1 <- doExprW word2 $ LlvmOp LM_MO_AShr r1 shift2
+                    rhigh2 <- doExprW word $ Cast LM_Trunc rhigh1 word
+                    doExprW word $ LlvmOp LM_MO_Sub rlow2 rhigh2
+
+                else
+                    panic $ "isSMulOK: Not bit type! (" ++ showSDoc dflags (ppr word) ++ ")"
+
+        panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: unary op encountered"
+                       ++ "with two arguments! (" ++ show op ++ ")"
+
+-- More than two expression, invalid!
+genMachOp_slow _ _ _ = panic "genMachOp: More than 2 expressions in MachOp!"
+
+
+-- | Handle CmmLoad expression.
+genLoad :: Atomic -> CmmExpr -> CmmType -> LlvmM ExprData
+
+-- First we try to detect a few common cases and produce better code for
+-- these then the default case. We are mostly trying to detect Cmm code
+-- like I32[Sp + n] and use 'getelementptr' operations instead of the
+-- generic case that uses casts and pointer arithmetic
+genLoad atomic e@(CmmReg (CmmGlobal r)) ty
+    = genLoad_fast atomic e r 0 ty
+
+genLoad atomic e@(CmmRegOff (CmmGlobal r) n) ty
+    = genLoad_fast atomic e r n ty
+
+genLoad atomic e@(CmmMachOp (MO_Add _) [
+                            (CmmReg (CmmGlobal r)),
+                            (CmmLit (CmmInt n _))])
+                ty
+    = genLoad_fast atomic e r (fromInteger n) ty
+
+genLoad atomic e@(CmmMachOp (MO_Sub _) [
+                            (CmmReg (CmmGlobal r)),
+                            (CmmLit (CmmInt n _))])
+                ty
+    = genLoad_fast atomic e r (negate $ fromInteger n) ty
+
+-- generic case
+genLoad atomic e ty
+    = getTBAAMeta topN >>= genLoad_slow atomic e ty
+
+-- | Handle CmmLoad expression.
+-- This is a special case for loading from a global register pointer
+-- offset such as I32[Sp+8].
+genLoad_fast :: Atomic -> CmmExpr -> GlobalReg -> Int -> CmmType
+             -> LlvmM ExprData
+genLoad_fast atomic e r n ty = do
+    dflags <- getDynFlags
+    (gv, grt, s1) <- getCmmRegVal (CmmGlobal r)
+    meta          <- getTBAARegMeta r
+    let ty'      = cmmToLlvmType ty
+        (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)
+    case isPointer grt && rem == 0 of
+            True  -> do
+                (ptr, s2) <- doExpr grt $ GetElemPtr True gv [toI32 ix]
+                -- We might need a different pointer type, so check
+                case grt == ty' of
+                     -- were fine
+                     True -> do
+                         (var, s3) <- doExpr ty' (MExpr meta $ loadInstr ptr)
+                         return (var, s1 `snocOL` s2 `snocOL` s3,
+                                     [])
+
+                     -- cast to pointer type needed
+                     False -> do
+                         let pty = pLift ty'
+                         (ptr', s3) <- doExpr pty $ Cast LM_Bitcast ptr pty
+                         (var, s4) <- doExpr ty' (MExpr meta $ loadInstr ptr')
+                         return (var, s1 `snocOL` s2 `snocOL` s3
+                                    `snocOL` s4, [])
+
+            -- If its a bit type then we use the slow method since
+            -- we can't avoid casting anyway.
+            False -> genLoad_slow atomic  e ty meta
+  where
+    loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr
+                  | otherwise = Load ptr
+
+-- | Handle Cmm load expression.
+-- Generic case. Uses casts and pointer arithmetic if needed.
+genLoad_slow :: Atomic -> CmmExpr -> CmmType -> [MetaAnnot] -> LlvmM ExprData
+genLoad_slow atomic e ty meta = runExprData $ do
+    iptr <- exprToVarW e
+    dflags <- getDynFlags
+    case getVarType iptr of
+         LMPointer _ -> do
+                    doExprW (cmmToLlvmType ty) (MExpr meta $ loadInstr iptr)
+
+         i@(LMInt _) | i == llvmWord dflags -> do
+                    let pty = LMPointer $ cmmToLlvmType ty
+                    ptr <- doExprW pty $ Cast LM_Inttoptr iptr pty
+                    doExprW (cmmToLlvmType ty) (MExpr meta $ loadInstr ptr)
+
+         other -> do pprPanic "exprToVar: CmmLoad expression is not right type!"
+                        (PprCmm.pprExpr e <+> text (
+                            "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
+                            ", Size of var: " ++ show (llvmWidthInBits dflags other) ++
+                            ", Var: " ++ showSDoc dflags (ppr iptr)))
+  where
+    loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr
+                  | otherwise = Load ptr
+
+
+-- | Handle CmmReg expression. This will return a pointer to the stack
+-- location of the register. Throws an error if it isn't allocated on
+-- the stack.
+getCmmReg :: CmmReg -> LlvmM LlvmVar
+getCmmReg (CmmLocal (LocalReg un _))
+  = do exists <- varLookup un
+       dflags <- getDynFlags
+       case exists of
+         Just ety -> return (LMLocalVar un $ pLift ety)
+         Nothing  -> panic $ "getCmmReg: Cmm register " ++ showSDoc dflags (ppr un) ++ " was not allocated!"
+           -- This should never happen, as every local variable should
+           -- have been assigned a value at some point, triggering
+           -- "funPrologue" to allocate it on the stack.
+
+getCmmReg (CmmGlobal g)
+  = do onStack <- checkStackReg g
+       dflags <- getDynFlags
+       if onStack
+         then return (lmGlobalRegVar dflags g)
+         else panic $ "getCmmReg: Cmm register " ++ showSDoc dflags (ppr g) ++ " not stack-allocated!"
+
+-- | Return the value of a given register, as well as its type. Might
+-- need to be load from stack.
+getCmmRegVal :: CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
+getCmmRegVal reg =
+  case reg of
+    CmmGlobal g -> do
+      onStack <- checkStackReg g
+      dflags <- getDynFlags
+      if onStack then loadFromStack else do
+        let r = lmGlobalRegArg dflags g
+        return (r, getVarType r, nilOL)
+    _ -> loadFromStack
+ where loadFromStack = do
+         ptr <- getCmmReg reg
+         let ty = pLower $ getVarType ptr
+         (v, s) <- doExpr ty (Load ptr)
+         return (v, ty, unitOL s)
+
+-- | Allocate a local CmmReg on the stack
+allocReg :: CmmReg -> (LlvmVar, LlvmStatements)
+allocReg (CmmLocal (LocalReg un ty))
+  = let ty' = cmmToLlvmType ty
+        var = LMLocalVar un (LMPointer ty')
+        alc = Alloca ty' 1
+    in (var, unitOL $ Assignment var alc)
+
+allocReg _ = panic $ "allocReg: Global reg encountered! Global registers should"
+                    ++ " have been handled elsewhere!"
+
+
+-- | Generate code for a literal
+genLit :: EOption -> CmmLit -> LlvmM ExprData
+genLit opt (CmmInt i w)
+  -- See Note [Literals and branch conditions].
+  = let width | i1Expected opt = i1
+              | otherwise      = LMInt (widthInBits w)
+        -- comm  = Comment [ fsLit $ "EOption: " ++ show opt
+        --                 , fsLit $ "Width  : " ++ show w
+        --                 , fsLit $ "Width' : " ++ show (widthInBits w)
+        --                 ]
+    in return (mkIntLit width i, nilOL, [])
+
+genLit _ (CmmFloat r w)
+  = return (LMLitVar $ LMFloatLit (fromRational r) (widthToLlvmFloat w),
+              nilOL, [])
+
+genLit opt (CmmVec ls)
+  = do llvmLits <- mapM toLlvmLit ls
+       return (LMLitVar $ LMVectorLit llvmLits, nilOL, [])
+  where
+    toLlvmLit :: CmmLit -> LlvmM LlvmLit
+    toLlvmLit lit = do
+        (llvmLitVar, _, _) <- genLit opt lit
+        case llvmLitVar of
+          LMLitVar llvmLit -> return llvmLit
+          _ -> panic "genLit"
+
+genLit _ cmm@(CmmLabel l)
+  = do var <- getGlobalPtr =<< strCLabel_llvm l
+       dflags <- getDynFlags
+       let lmty = cmmToLlvmType $ cmmLitType dflags cmm
+       (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)
+       return (v1, unitOL s1, [])
+
+genLit opt (CmmLabelOff label off) = do
+    dflags <- getDynFlags
+    (vlbl, stmts, stat) <- genLit opt (CmmLabel label)
+    let voff = toIWord dflags off
+    (v1, s1) <- doExpr (getVarType vlbl) $ LlvmOp LM_MO_Add vlbl voff
+    return (v1, stmts `snocOL` s1, stat)
+
+genLit opt (CmmLabelDiffOff l1 l2 off w) = do
+    dflags <- getDynFlags
+    (vl1, stmts1, stat1) <- genLit opt (CmmLabel l1)
+    (vl2, stmts2, stat2) <- genLit opt (CmmLabel l2)
+    let voff = toIWord dflags off
+    let ty1 = getVarType vl1
+    let ty2 = getVarType vl2
+    if (isInt ty1) && (isInt ty2)
+       && (llvmWidthInBits dflags ty1 == llvmWidthInBits dflags ty2)
+       then do
+            (v1, s1) <- doExpr (getVarType vl1) $ LlvmOp LM_MO_Sub vl1 vl2
+            (v2, s2) <- doExpr (getVarType v1 ) $ LlvmOp LM_MO_Add v1 voff
+            let ty = widthToLlvmInt w
+            let stmts = stmts1 `appOL` stmts2 `snocOL` s1 `snocOL` s2
+            if w /= wordWidth dflags
+              then do
+                (v3, s3) <- doExpr ty $ Cast LM_Trunc v2 ty
+                return (v3, stmts `snocOL` s3, stat1 ++ stat2)
+              else
+                return (v2, stmts, stat1 ++ stat2)
+        else
+            panic "genLit: CmmLabelDiffOff encountered with different label ty!"
+
+genLit opt (CmmBlock b)
+  = genLit opt (CmmLabel $ infoTblLbl b)
+
+genLit _ CmmHighStackMark
+  = panic "genStaticLit - CmmHighStackMark unsupported!"
+
+
+-- -----------------------------------------------------------------------------
+-- * Misc
+--
+
+-- | Find CmmRegs that get assigned and allocate them on the stack
+--
+-- Any register that gets written needs to be allocated on the
+-- stack. This avoids having to map a CmmReg to an equivalent SSA form
+-- and avoids having to deal with Phi node insertion.  This is also
+-- the approach recommended by LLVM developers.
+--
+-- On the other hand, this is unnecessarily verbose if the register in
+-- question is never written. Therefore we skip it where we can to
+-- save a few lines in the output and hopefully speed compilation up a
+-- bit.
+funPrologue :: LiveGlobalRegs -> [CmmBlock] -> LlvmM StmtData
+funPrologue live cmmBlocks = do
+
+  let getAssignedRegs :: CmmNode O O -> [CmmReg]
+      getAssignedRegs (CmmAssign reg _)  = [reg]
+      getAssignedRegs (CmmUnsafeForeignCall _ rs _) = map CmmLocal rs
+      getAssignedRegs _                  = []
+      getRegsBlock (_, body, _)          = concatMap getAssignedRegs $ blockToList body
+      assignedRegs = nub $ concatMap (getRegsBlock . blockSplit) cmmBlocks
+      isLive r     = r `elem` alwaysLive || r `elem` live
+
+  dflags <- getDynFlags
+  stmtss <- flip mapM assignedRegs $ \reg ->
+    case reg of
+      CmmLocal (LocalReg un _) -> do
+        let (newv, stmts) = allocReg reg
+        varInsert un (pLower $ getVarType newv)
+        return stmts
+      CmmGlobal r -> do
+        let reg   = lmGlobalRegVar dflags r
+            arg   = lmGlobalRegArg dflags r
+            ty    = (pLower . getVarType) reg
+            trash = LMLitVar $ LMUndefLit ty
+            rval  = if isLive r then arg else trash
+            alloc = Assignment reg $ Alloca (pLower $ getVarType reg) 1
+        markStackReg r
+        return $ toOL [alloc, Store rval reg]
+
+  return (concatOL stmtss `snocOL` jumpToEntry, [])
+  where
+    entryBlk : _ = cmmBlocks
+    jumpToEntry = Branch $ blockIdToLlvm (entryLabel entryBlk)
+
+-- | Function epilogue. Load STG variables to use as argument for call.
+-- STG Liveness optimisation done here.
+funEpilogue :: LiveGlobalRegs -> LlvmM ([LlvmVar], LlvmStatements)
+funEpilogue live = do
+    dflags <- getDynFlags
+
+    -- the bool indicates whether the register is padding.
+    let alwaysNeeded = map (\r -> (False, r)) alwaysLive
+        livePadded = alwaysNeeded ++ padLiveArgs dflags live
+
+    -- Set to value or "undef" depending on whether the register is
+    -- actually live
+    let loadExpr r = do
+          (v, _, s) <- getCmmRegVal (CmmGlobal r)
+          return (Just $ v, s)
+        loadUndef r = do
+          let ty = (pLower . getVarType $ lmGlobalRegVar dflags r)
+          return (Just $ LMLitVar $ LMUndefLit ty, nilOL)
+    platform <- getDynFlag targetPlatform
+    let allRegs = activeStgRegs platform
+    loads <- flip mapM allRegs $ \r -> case () of
+      _ | (False, r) `elem` livePadded
+                             -> loadExpr r   -- if r is not padding, load it
+        | not (isFPR r) || (True, r) `elem` livePadded
+                             -> loadUndef r
+        | otherwise          -> return (Nothing, nilOL)
+
+    let (vars, stmts) = unzip loads
+    return (catMaybes vars, concatOL stmts)
+
+-- | Get a function pointer to the CLabel specified.
+--
+-- This is for Haskell functions, function type is assumed, so doesn't work
+-- with foreign functions.
+getHsFunc :: LiveGlobalRegs -> CLabel -> LlvmM ExprData
+getHsFunc live lbl
+  = do fty <- llvmFunTy live
+       name <- strCLabel_llvm lbl
+       getHsFunc' name fty
+
+getHsFunc' :: LMString -> LlvmType -> LlvmM ExprData
+getHsFunc' name fty
+  = do fun <- getGlobalPtr name
+       if getVarType fun == fty
+         then return (fun, nilOL, [])
+         else do (v1, s1) <- doExpr (pLift fty)
+                               $ Cast LM_Bitcast fun (pLift fty)
+                 return  (v1, unitOL s1, [])
+
+-- | Create a new local var
+mkLocalVar :: LlvmType -> LlvmM LlvmVar
+mkLocalVar ty = do
+    un <- getUniqueM
+    return $ LMLocalVar un ty
+
+
+-- | Execute an expression, assigning result to a var
+doExpr :: LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
+doExpr ty expr = do
+    v <- mkLocalVar ty
+    return (v, Assignment v expr)
+
+
+-- | Expand CmmRegOff
+expandCmmReg :: DynFlags -> (CmmReg, Int) -> CmmExpr
+expandCmmReg dflags (reg, off)
+  = let width = typeWidth (cmmRegType dflags reg)
+        voff  = CmmLit $ CmmInt (fromIntegral off) width
+    in CmmMachOp (MO_Add width) [CmmReg reg, voff]
+
+
+-- | Convert a block id into a appropriate Llvm label
+blockIdToLlvm :: BlockId -> LlvmVar
+blockIdToLlvm bid = LMLocalVar (getUnique bid) LMLabel
+
+-- | Create Llvm int Literal
+mkIntLit :: Integral a => LlvmType -> a -> LlvmVar
+mkIntLit ty i = LMLitVar $ LMIntLit (toInteger i) ty
+
+-- | Convert int type to a LLvmVar of word or i32 size
+toI32 :: Integral a => a -> LlvmVar
+toI32 = mkIntLit i32
+
+toIWord :: Integral a => DynFlags -> a -> LlvmVar
+toIWord dflags = mkIntLit (llvmWord dflags)
+
+
+-- | Error functions
+panic :: String -> a
+panic s = Outputable.panic $ "GHC.CmmToLlvm.CodeGen." ++ s
+
+pprPanic :: String -> SDoc -> a
+pprPanic s d = Outputable.pprPanic ("GHC.CmmToLlvm.CodeGen." ++ s) d
+
+
+-- | Returns TBAA meta data by unique
+getTBAAMeta :: Unique -> LlvmM [MetaAnnot]
+getTBAAMeta u = do
+    mi <- getUniqMeta u
+    return [MetaAnnot tbaa (MetaNode i) | let Just i = mi]
+
+-- | Returns TBAA meta data for given register
+getTBAARegMeta :: GlobalReg -> LlvmM [MetaAnnot]
+getTBAARegMeta = getTBAAMeta . getTBAA
+
+
+-- | A more convenient way of accumulating LLVM statements and declarations.
+data LlvmAccum = LlvmAccum LlvmStatements [LlvmCmmDecl]
+
+instance Semigroup LlvmAccum where
+  LlvmAccum stmtsA declsA <> LlvmAccum stmtsB declsB =
+        LlvmAccum (stmtsA Semigroup.<> stmtsB) (declsA Semigroup.<> declsB)
+
+instance Monoid LlvmAccum where
+    mempty = LlvmAccum nilOL []
+    mappend = (Semigroup.<>)
+
+liftExprData :: LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
+liftExprData action = do
+    (var, stmts, decls) <- lift action
+    tell $ LlvmAccum stmts decls
+    return var
+
+statement :: LlvmStatement -> WriterT LlvmAccum LlvmM ()
+statement stmt = tell $ LlvmAccum (unitOL stmt) []
+
+doExprW :: LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
+doExprW a b = do
+    (var, stmt) <- lift $ doExpr a b
+    statement stmt
+    return var
+
+exprToVarW :: CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
+exprToVarW = liftExprData . exprToVar
+
+runExprData :: WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
+runExprData action = do
+    (var, LlvmAccum stmts decls) <- runWriterT action
+    return (var, stmts, decls)
+
+runStmtsDecls :: WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
+runStmtsDecls action = do
+    LlvmAccum stmts decls <- execWriterT action
+    return (stmts, decls)
+
+getCmmRegW :: CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
+getCmmRegW = lift . getCmmReg
+
+genLoadW :: Atomic -> CmmExpr -> CmmType -> WriterT LlvmAccum LlvmM LlvmVar
+genLoadW atomic e ty = liftExprData $ genLoad atomic e ty
+
+-- | Return element of single-element list; 'panic' if list is not a single-element list
+singletonPanic :: String -> [a] -> a
+singletonPanic _ [x] = x
+singletonPanic s _ = panic s
diff --git a/compiler/GHC/CmmToLlvm/Data.hs b/compiler/GHC/CmmToLlvm/Data.hs
new file mode 100644
index 0000000000..b20c9bd360
--- /dev/null
+++ b/compiler/GHC/CmmToLlvm/Data.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE CPP #-}
+-- ----------------------------------------------------------------------------
+-- | Handle conversion of CmmData to LLVM code.
+--
+
+module GHC.CmmToLlvm.Data (
+        genLlvmData, genData
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Llvm
+import GHC.CmmToLlvm.Base
+
+import GHC.Cmm.BlockId
+import GHC.Cmm.CLabel
+import GHC.Cmm
+import DynFlags
+import GHC.Platform
+
+import FastString
+import Outputable
+import qualified Data.ByteString as BS
+
+-- ----------------------------------------------------------------------------
+-- * Constants
+--
+
+-- | The string appended to a variable name to create its structure type alias
+structStr :: LMString
+structStr = fsLit "_struct"
+
+-- | The LLVM visibility of the label
+linkage :: CLabel -> LlvmLinkageType
+linkage lbl = if externallyVisibleCLabel lbl
+              then ExternallyVisible else Internal
+
+-- ----------------------------------------------------------------------------
+-- * Top level
+--
+
+-- | Pass a CmmStatic section to an equivalent Llvm code.
+genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
+-- See note [emit-time elimination of static indirections] in CLabel.
+genLlvmData (_, RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
+  | lbl == mkIndStaticInfoLabel
+  , let labelInd (CmmLabelOff l _) = Just l
+        labelInd (CmmLabel l) = Just l
+        labelInd _ = Nothing
+  , Just ind' <- labelInd ind
+  , alias `mayRedirectTo` ind' = do
+    label <- strCLabel_llvm alias
+    label' <- strCLabel_llvm ind'
+    let link     = linkage alias
+        link'    = linkage ind'
+        -- the LLVM type we give the alias is an empty struct type
+        -- but it doesn't really matter, as the pointer is only
+        -- used for (bit/int)casting.
+        tyAlias  = LMAlias (label `appendFS` structStr, LMStructU [])
+
+        aliasDef = LMGlobalVar label tyAlias link Nothing Nothing Alias
+        -- we don't know the type of the indirectee here
+        indType  = panic "will be filled by 'aliasify', later"
+        orig     = LMStaticPointer $ LMGlobalVar label' indType link' Nothing Nothing Alias
+
+    pure ([LMGlobal aliasDef $ Just orig], [tyAlias])
+
+genLlvmData (sec, RawCmmStatics lbl xs) = do
+    label <- strCLabel_llvm lbl
+    static <- mapM genData xs
+    lmsec <- llvmSection sec
+    platform <- getLlvmPlatform
+    let types   = map getStatType static
+
+        strucTy = LMStruct types
+        tyAlias = LMAlias (label `appendFS` structStr, strucTy)
+
+        struct         = Just $ LMStaticStruc static tyAlias
+        link           = linkage lbl
+        align          = case sec of
+                            Section CString _ -> if (platformArch platform == ArchS390X)
+                                                    then Just 2 else Just 1
+                            _                 -> Nothing
+        const          = if isSecConstant sec then Constant else Global
+        varDef         = LMGlobalVar label tyAlias link lmsec align const
+        globDef        = LMGlobal varDef struct
+
+    return ([globDef], [tyAlias])
+
+-- | Format the section type part of a Cmm Section
+llvmSectionType :: Platform -> SectionType -> FastString
+llvmSectionType p t = case t of
+    Text                    -> fsLit ".text"
+    ReadOnlyData            -> case platformOS p of
+                                 OSMinGW32 -> fsLit ".rdata"
+                                 _         -> fsLit ".rodata"
+    RelocatableReadOnlyData -> case platformOS p of
+                                 OSMinGW32 -> fsLit ".rdata$rel.ro"
+                                 _         -> fsLit ".data.rel.ro"
+    ReadOnlyData16          -> case platformOS p of
+                                 OSMinGW32 -> fsLit ".rdata$cst16"
+                                 _         -> fsLit ".rodata.cst16"
+    Data                    -> fsLit ".data"
+    UninitialisedData       -> fsLit ".bss"
+    CString                 -> case platformOS p of
+                                 OSMinGW32 -> fsLit ".rdata$str"
+                                 _         -> fsLit ".rodata.str"
+    (OtherSection _)        -> panic "llvmSectionType: unknown section type"
+
+-- | 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
+  if not splitSect
+  then return Nothing
+  else do
+    lmsuffix <- strCLabel_llvm suffix
+    let result sep = Just (concatFS [llvmSectionType platform t
+                                    , fsLit sep, lmsuffix])
+    case platformOS platform of
+      OSMinGW32 -> return (result "$")
+      _         -> return (result ".")
+
+-- ----------------------------------------------------------------------------
+-- * Generate static data
+--
+
+-- | Handle static data
+genData :: CmmStatic -> LlvmM LlvmStatic
+
+genData (CmmString str) = do
+    let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8)
+                 (BS.unpack str)
+        ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
+    return $ LMStaticArray ve (LMArray (length ve) i8)
+
+genData (CmmUninitialised bytes)
+    = return $ LMUninitType (LMArray bytes i8)
+
+genData (CmmStaticLit lit)
+    = genStaticLit lit
+
+-- | Generate Llvm code for a static literal.
+--
+-- Will either generate the code or leave it unresolved if it is a 'CLabel'
+-- which isn't yet known.
+genStaticLit :: CmmLit -> LlvmM LlvmStatic
+genStaticLit (CmmInt i w)
+    = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
+
+genStaticLit (CmmFloat r w)
+    = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
+
+genStaticLit (CmmVec ls)
+    = do sls <- mapM toLlvmLit ls
+         return $ LMStaticLit (LMVectorLit sls)
+  where
+    toLlvmLit :: CmmLit -> LlvmM LlvmLit
+    toLlvmLit lit = do
+      slit <- genStaticLit lit
+      case slit of
+        LMStaticLit llvmLit -> return llvmLit
+        _ -> panic "genStaticLit"
+
+-- Leave unresolved, will fix later
+genStaticLit cmm@(CmmLabel l) = do
+    var <- getGlobalPtr =<< strCLabel_llvm l
+    dflags <- getDynFlags
+    let ptr = LMStaticPointer var
+        lmty = cmmToLlvmType $ cmmLitType dflags cmm
+    return $ LMPtoI ptr lmty
+
+genStaticLit (CmmLabelOff label off) = do
+    dflags <- getDynFlags
+    var <- genStaticLit (CmmLabel label)
+    let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
+    return $ LMAdd var offset
+
+genStaticLit (CmmLabelDiffOff l1 l2 off w) = do
+    dflags <- getDynFlags
+    var1 <- genStaticLit (CmmLabel l1)
+    var2 <- genStaticLit (CmmLabel l2)
+    let var
+          | w == wordWidth dflags = LMSub var1 var2
+          | otherwise = LMTrunc (LMSub var1 var2) (widthToLlvmInt w)
+        offset = LMStaticLit $ LMIntLit (toInteger off) (LMInt $ widthInBits w)
+    return $ LMAdd var offset
+
+genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
+
+genStaticLit (CmmHighStackMark)
+    = panic "genStaticLit: CmmHighStackMark unsupported!"
diff --git a/compiler/GHC/CmmToLlvm/Mangler.hs b/compiler/GHC/CmmToLlvm/Mangler.hs
new file mode 100644
index 0000000000..1cdad2009f
--- /dev/null
+++ b/compiler/GHC/CmmToLlvm/Mangler.hs
@@ -0,0 +1,129 @@
+-- -----------------------------------------------------------------------------
+-- | GHC LLVM Mangler
+--
+-- This script processes the assembly produced by LLVM, rewriting all symbols
+-- of type @function to @object. This keeps them from going through the PLT,
+-- which would be bad due to tables-next-to-code. On x86_64,
+-- it also rewrites AVX instructions that require alignment to their
+-- unaligned counterparts, since the stack is only 16-byte aligned but these
+-- instructions require 32-byte alignment.
+--
+
+module GHC.CmmToLlvm.Mangler ( llvmFixupAsm ) where
+
+import GhcPrelude
+
+import DynFlags ( DynFlags, targetPlatform )
+import GHC.Platform ( platformArch, Arch(..) )
+import ErrUtils ( withTiming )
+import Outputable ( text )
+
+import Control.Exception
+import qualified Data.ByteString.Char8 as B
+import System.IO
+
+-- | Read in assembly file and process
+llvmFixupAsm :: DynFlags -> FilePath -> FilePath -> IO ()
+llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-}
+    withTiming dflags (text "LLVM Mangler") id $
+    withBinaryFile f1 ReadMode $ \r -> withBinaryFile f2 WriteMode $ \w -> do
+        go r w
+        hClose r
+        hClose w
+        return ()
+  where
+    go :: Handle -> Handle -> IO ()
+    go r w = do
+      e_l <- try $ B.hGetLine r ::IO (Either IOError B.ByteString)
+      let writeline a = B.hPutStrLn w (rewriteLine dflags rewrites a) >> go r w
+      case e_l of
+        Right l -> writeline l
+        Left _  -> return ()
+
+-- | These are the rewrites that the mangler will perform
+rewrites :: [Rewrite]
+rewrites = [rewriteSymType, rewriteAVX]
+
+type Rewrite = DynFlags -> B.ByteString -> Maybe B.ByteString
+
+-- | Rewrite a line of assembly source with the given rewrites,
+-- taking the first rewrite that applies.
+rewriteLine :: DynFlags -> [Rewrite] -> B.ByteString -> B.ByteString
+rewriteLine dflags rewrites l
+  -- We disable .subsections_via_symbols on darwin and ios, as the llvm code
+  -- gen uses prefix data for the info table.  This however does not prevent
+  -- llvm from generating .subsections_via_symbols, which in turn with
+  -- -dead_strip, strips the info tables, and therefore breaks ghc.
+  | isSubsectionsViaSymbols l =
+    (B.pack "## no .subsection_via_symbols for ghc. We need our info tables!")
+  | otherwise =
+    case firstJust $ map (\rewrite -> rewrite dflags rest) rewrites of
+      Nothing        -> l
+      Just rewritten -> B.concat $ [symbol, B.pack "\t", rewritten]
+  where
+    isSubsectionsViaSymbols = B.isPrefixOf (B.pack ".subsections_via_symbols")
+
+    (symbol, rest) = splitLine l
+
+    firstJust :: [Maybe a] -> Maybe a
+    firstJust (Just x:_) = Just x
+    firstJust []         = Nothing
+    firstJust (_:rest)   = firstJust rest
+
+-- | This rewrites @.type@ annotations of function symbols to @%object@.
+-- This is done as the linker can relocate @%functions@ through the
+-- Procedure Linking Table (PLT). This is bad since we expect that the
+-- info table will appear directly before the symbol's location. In the
+-- case that the PLT is used, this will be not an info table but instead
+-- some random PLT garbage.
+rewriteSymType :: Rewrite
+rewriteSymType _ l
+  | isType l  = Just $ rewrite '@' $ rewrite '%' l
+  | otherwise = Nothing
+  where
+    isType = B.isPrefixOf (B.pack ".type")
+
+    rewrite :: Char -> B.ByteString -> B.ByteString
+    rewrite prefix = replaceOnce funcType objType
+      where
+        funcType = prefix `B.cons` B.pack "function"
+        objType  = prefix `B.cons` B.pack "object"
+
+-- | This rewrites aligned AVX instructions to their unaligned counterparts on
+-- x86-64. This is necessary because the stack is not adequately aligned for
+-- aligned AVX spills, so LLVM would emit code that adjusts the stack pointer
+-- and disable tail call optimization. Both would be catastrophic here so GHC
+-- tells LLVM that the stack is 32-byte aligned (even though it isn't) and then
+-- rewrites the instructions in the mangler.
+rewriteAVX :: Rewrite
+rewriteAVX dflags s
+  | not isX86_64 = Nothing
+  | isVmovdqa s  = Just $ replaceOnce (B.pack "vmovdqa") (B.pack "vmovdqu") s
+  | isVmovap s   = Just $ replaceOnce (B.pack "vmovap") (B.pack "vmovup") s
+  | otherwise    = Nothing
+  where
+    isX86_64 = platformArch (targetPlatform dflags) == ArchX86_64
+    isVmovdqa = B.isPrefixOf (B.pack "vmovdqa")
+    isVmovap = B.isPrefixOf (B.pack "vmovap")
+
+-- | @replaceOnce match replace bs@ replaces the first occurrence of the
+-- substring @match@ in @bs@ with @replace@.
+replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
+replaceOnce matchBS replaceOnceBS = loop
+  where
+    loop :: B.ByteString -> B.ByteString
+    loop cts =
+        case B.breakSubstring matchBS cts of
+          (hd,tl) | B.null tl -> hd
+                  | otherwise -> hd `B.append` replaceOnceBS `B.append`
+                                 B.drop (B.length matchBS) tl
+
+-- | This function splits a line of assembly code into the label and the
+-- rest of the code.
+splitLine :: B.ByteString -> (B.ByteString, B.ByteString)
+splitLine l = (symbol, B.dropWhile isSpace rest)
+  where
+    isSpace ' ' = True
+    isSpace '\t' = True
+    isSpace _ = False
+    (symbol, rest) = B.span (not . isSpace) l
diff --git a/compiler/GHC/CmmToLlvm/Ppr.hs b/compiler/GHC/CmmToLlvm/Ppr.hs
new file mode 100644
index 0000000000..45a8285ec6
--- /dev/null
+++ b/compiler/GHC/CmmToLlvm/Ppr.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE CPP #-}
+
+-- ----------------------------------------------------------------------------
+-- | Pretty print helpers for the LLVM Code generator.
+--
+module GHC.CmmToLlvm.Ppr (
+        pprLlvmCmmDecl, pprLlvmData, infoSection
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Llvm
+import GHC.CmmToLlvm.Base
+import GHC.CmmToLlvm.Data
+
+import GHC.Cmm.CLabel
+import GHC.Cmm
+
+import FastString
+import Outputable
+import Unique
+
+-- ----------------------------------------------------------------------------
+-- * Top level
+--
+
+-- | Pretty print LLVM data code
+pprLlvmData :: LlvmData -> SDoc
+pprLlvmData (globals, types) =
+    let ppLlvmTys (LMAlias    a) = ppLlvmAlias a
+        ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
+        ppLlvmTys _other         = empty
+
+        types'   = vcat $ map ppLlvmTys types
+        globals' = ppLlvmGlobals globals
+    in types' $+$ globals'
+
+
+-- | Pretty print LLVM code
+pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
+pprLlvmCmmDecl (CmmData _ lmdata)
+  = return (vcat $ map pprLlvmData lmdata, [])
+
+pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
+  = do let lbl = case mb_info of
+                     Nothing -> entry_lbl
+                     Just (RawCmmStatics info_lbl _) -> info_lbl
+           link = if externallyVisibleCLabel lbl
+                      then ExternallyVisible
+                      else Internal
+           lmblocks = map (\(BasicBlock id stmts) ->
+                                LlvmBlock (getUnique id) stmts) blks
+
+       funDec <- llvmFunSig live lbl link
+       dflags <- getDynFlags
+       let buildArg = fsLit . showSDoc dflags . ppPlainName
+           funArgs = map buildArg (llvmFunArgs dflags live)
+           funSect = llvmFunSection dflags (decName funDec)
+
+       -- generate the info table
+       prefix <- case mb_info of
+                     Nothing -> return Nothing
+                     Just (RawCmmStatics _ statics) -> do
+                       infoStatics <- mapM genData statics
+                       let infoTy = LMStruct $ map getStatType infoStatics
+                       return $ Just $ LMStaticStruc infoStatics infoTy
+
+
+       let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect
+                              prefix lmblocks
+           name = decName $ funcDecl fun
+           defName = llvmDefLabel name
+           funcDecl' = (funcDecl fun) { decName = defName }
+           fun' = fun { funcDecl = funcDecl' }
+           funTy = LMFunction funcDecl'
+           funVar = LMGlobalVar name
+                                (LMPointer funTy)
+                                link
+                                Nothing
+                                Nothing
+                                Alias
+           defVar = LMGlobalVar defName
+                                (LMPointer funTy)
+                                (funcLinkage funcDecl')
+                                (funcSect fun)
+                                (funcAlign funcDecl')
+                                Alias
+           alias = LMGlobal funVar
+                            (Just $ LMBitc (LMStaticPointer defVar)
+                                           i8Ptr)
+
+       return (ppLlvmGlobal alias $+$ ppLlvmFunction fun', [])
+
+
+-- | The section we are putting info tables and their entry code into, should
+-- be unique since we process the assembly pattern matching this.
+infoSection :: String
+infoSection = "X98A__STRIP,__me"
diff --git a/compiler/GHC/CmmToLlvm/Regs.hs b/compiler/GHC/CmmToLlvm/Regs.hs
new file mode 100644
index 0000000000..60c27c8f44
--- /dev/null
+++ b/compiler/GHC/CmmToLlvm/Regs.hs
@@ -0,0 +1,136 @@
+{-# LANGUAGE CPP #-}
+
+--------------------------------------------------------------------------------
+-- | Deal with Cmm registers
+--
+
+module GHC.CmmToLlvm.Regs (
+        lmGlobalRegArg, lmGlobalRegVar, alwaysLive,
+        stgTBAA, baseN, stackN, heapN, rxN, topN, tbaa, getTBAA
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Llvm
+
+import GHC.Cmm.Expr
+import DynFlags
+import FastString
+import Outputable ( panic )
+import Unique
+
+-- | Get the LlvmVar function variable storing the real register
+lmGlobalRegVar :: DynFlags -> GlobalReg -> LlvmVar
+lmGlobalRegVar dflags = pVarLift . lmGlobalReg dflags "_Var"
+
+-- | Get the LlvmVar function argument storing the real register
+lmGlobalRegArg :: DynFlags -> GlobalReg -> LlvmVar
+lmGlobalRegArg dflags = lmGlobalReg dflags "_Arg"
+
+{- Need to make sure the names here can't conflict with the unique generated
+   names. Uniques generated names containing only base62 chars. So using say
+   the '_' char guarantees this.
+-}
+lmGlobalReg :: DynFlags -> String -> GlobalReg -> LlvmVar
+lmGlobalReg dflags suf reg
+  = case reg of
+        BaseReg        -> ptrGlobal $ "Base" ++ suf
+        Sp             -> ptrGlobal $ "Sp" ++ suf
+        Hp             -> ptrGlobal $ "Hp" ++ suf
+        VanillaReg 1 _ -> wordGlobal $ "R1" ++ suf
+        VanillaReg 2 _ -> wordGlobal $ "R2" ++ suf
+        VanillaReg 3 _ -> wordGlobal $ "R3" ++ suf
+        VanillaReg 4 _ -> wordGlobal $ "R4" ++ suf
+        VanillaReg 5 _ -> wordGlobal $ "R5" ++ suf
+        VanillaReg 6 _ -> wordGlobal $ "R6" ++ suf
+        VanillaReg 7 _ -> wordGlobal $ "R7" ++ suf
+        VanillaReg 8 _ -> wordGlobal $ "R8" ++ suf
+        SpLim          -> wordGlobal $ "SpLim" ++ suf
+        FloatReg 1     -> floatGlobal $"F1" ++ suf
+        FloatReg 2     -> floatGlobal $"F2" ++ suf
+        FloatReg 3     -> floatGlobal $"F3" ++ suf
+        FloatReg 4     -> floatGlobal $"F4" ++ suf
+        FloatReg 5     -> floatGlobal $"F5" ++ suf
+        FloatReg 6     -> floatGlobal $"F6" ++ suf
+        DoubleReg 1    -> doubleGlobal $ "D1" ++ suf
+        DoubleReg 2    -> doubleGlobal $ "D2" ++ suf
+        DoubleReg 3    -> doubleGlobal $ "D3" ++ suf
+        DoubleReg 4    -> doubleGlobal $ "D4" ++ suf
+        DoubleReg 5    -> doubleGlobal $ "D5" ++ suf
+        DoubleReg 6    -> doubleGlobal $ "D6" ++ suf
+        XmmReg 1       -> xmmGlobal $ "XMM1" ++ suf
+        XmmReg 2       -> xmmGlobal $ "XMM2" ++ suf
+        XmmReg 3       -> xmmGlobal $ "XMM3" ++ suf
+        XmmReg 4       -> xmmGlobal $ "XMM4" ++ suf
+        XmmReg 5       -> xmmGlobal $ "XMM5" ++ suf
+        XmmReg 6       -> xmmGlobal $ "XMM6" ++ suf
+        YmmReg 1       -> ymmGlobal $ "YMM1" ++ suf
+        YmmReg 2       -> ymmGlobal $ "YMM2" ++ suf
+        YmmReg 3       -> ymmGlobal $ "YMM3" ++ suf
+        YmmReg 4       -> ymmGlobal $ "YMM4" ++ suf
+        YmmReg 5       -> ymmGlobal $ "YMM5" ++ suf
+        YmmReg 6       -> ymmGlobal $ "YMM6" ++ suf
+        ZmmReg 1       -> zmmGlobal $ "ZMM1" ++ suf
+        ZmmReg 2       -> zmmGlobal $ "ZMM2" ++ suf
+        ZmmReg 3       -> zmmGlobal $ "ZMM3" ++ suf
+        ZmmReg 4       -> zmmGlobal $ "ZMM4" ++ suf
+        ZmmReg 5       -> zmmGlobal $ "ZMM5" ++ suf
+        ZmmReg 6       -> zmmGlobal $ "ZMM6" ++ suf
+        MachSp         -> wordGlobal $ "MachSp" ++ suf
+        _other         -> panic $ "GHC.CmmToLlvm.Reg: GlobalReg (" ++ (show reg)
+                                ++ ") not supported!"
+        -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc
+        -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg
+    where
+        wordGlobal   name = LMNLocalVar (fsLit name) (llvmWord dflags)
+        ptrGlobal    name = LMNLocalVar (fsLit name) (llvmWordPtr dflags)
+        floatGlobal  name = LMNLocalVar (fsLit name) LMFloat
+        doubleGlobal name = LMNLocalVar (fsLit name) LMDouble
+        xmmGlobal    name = LMNLocalVar (fsLit name) (LMVector 4 (LMInt 32))
+        ymmGlobal    name = LMNLocalVar (fsLit name) (LMVector 8 (LMInt 32))
+        zmmGlobal    name = LMNLocalVar (fsLit name) (LMVector 16 (LMInt 32))
+
+-- | A list of STG Registers that should always be considered alive
+alwaysLive :: [GlobalReg]
+alwaysLive = [BaseReg, Sp, Hp, SpLim, HpLim, node]
+
+-- | STG Type Based Alias Analysis hierarchy
+stgTBAA :: [(Unique, LMString, Maybe Unique)]
+stgTBAA
+  = [ (rootN,  fsLit "root",   Nothing)
+    , (topN,   fsLit "top",   Just rootN)
+    , (stackN, fsLit "stack", Just topN)
+    , (heapN,  fsLit "heap",  Just topN)
+    , (rxN,    fsLit "rx",    Just heapN)
+    , (baseN,  fsLit "base",  Just topN)
+    -- FIX: Not 100% sure if this hierarchy is complete.  I think the big thing
+    -- is Sp is never aliased, so might want to change the hierarchy to have Sp
+    -- on its own branch that is never aliased (e.g never use top as a TBAA
+    -- node).
+    ]
+
+-- | Id values
+-- The `rootN` node is the root (there can be more than one) of the TBAA
+-- hierarchy and as of LLVM 4.0 should *only* be referenced by other nodes. It
+-- should never occur in any LLVM instruction statement.
+rootN, topN, stackN, heapN, rxN, baseN :: Unique
+rootN  = getUnique (fsLit "GHC.CmmToLlvm.Regs.rootN")
+topN   = getUnique (fsLit "GHC.CmmToLlvm.Regs.topN")
+stackN = getUnique (fsLit "GHC.CmmToLlvm.Regs.stackN")
+heapN  = getUnique (fsLit "GHC.CmmToLlvm.Regs.heapN")
+rxN    = getUnique (fsLit "GHC.CmmToLlvm.Regs.rxN")
+baseN  = getUnique (fsLit "GHC.CmmToLlvm.Regs.baseN")
+
+-- | The TBAA metadata identifier
+tbaa :: LMString
+tbaa = fsLit "tbaa"
+
+-- | Get the correct TBAA metadata information for this register type
+getTBAA :: GlobalReg -> Unique
+getTBAA BaseReg          = baseN
+getTBAA Sp               = stackN
+getTBAA Hp               = heapN
+getTBAA (VanillaReg _ _) = rxN
+getTBAA _                = topN
diff --git a/compiler/GHC/Llvm.hs b/compiler/GHC/Llvm.hs
new file mode 100644
index 0000000000..65389a7a5b
--- /dev/null
+++ b/compiler/GHC/Llvm.hs
@@ -0,0 +1,64 @@
+-- ----------------------------------------------------------------------------
+-- | This module supplies bindings to generate Llvm IR from Haskell
+-- (<http://www.llvm.org/docs/LangRef.html>).
+--
+-- Note: this module is developed in a demand driven way. It is no complete
+-- LLVM binding library in Haskell, but enough to generate code for GHC.
+--
+-- This code is derived from code taken from the Essential Haskell Compiler
+-- (EHC) project (<http://www.cs.uu.nl/wiki/Ehc/WebHome>).
+--
+
+module GHC.Llvm (
+
+        -- * Modules, Functions and Blocks
+        LlvmModule(..),
+
+        LlvmFunction(..), LlvmFunctionDecl(..),
+        LlvmFunctions, LlvmFunctionDecls,
+        LlvmStatement(..), LlvmExpression(..),
+        LlvmBlocks, LlvmBlock(..), LlvmBlockId,
+        LlvmParamAttr(..), LlvmParameter,
+
+        -- * Atomic operations
+        LlvmAtomicOp(..),
+
+        -- * Fence synchronization
+        LlvmSyncOrdering(..),
+
+        -- * Call Handling
+        LlvmCallConvention(..), LlvmCallType(..), LlvmParameterListType(..),
+        LlvmLinkageType(..), LlvmFuncAttr(..),
+
+        -- * Operations and Comparisons
+        LlvmCmpOp(..), LlvmMachOp(..), LlvmCastOp(..),
+
+        -- * Variables and Type System
+        LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..),
+        LlvmAlias, LMGlobal(..), LMString, LMSection, LMAlign,
+        LMConst(..),
+
+        -- ** Some basic types
+        i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
+
+        -- ** Metadata types
+        MetaExpr(..), MetaAnnot(..), MetaDecl(..), MetaId(..),
+
+        -- ** Operations on the type system.
+        isGlobal, getLitType, getVarType,
+        getLink, getStatType, pVarLift, pVarLower,
+        pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits,
+
+        -- * Pretty Printing
+        ppLit, ppName, ppPlainName,
+        ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals,
+        ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions,
+        ppLlvmFunction, ppLlvmAlias, ppLlvmAliases, ppLlvmMetas, ppLlvmMeta,
+
+    ) where
+
+import GHC.Llvm.Syntax
+import GHC.Llvm.MetaData
+import GHC.Llvm.Ppr
+import GHC.Llvm.Types
+
diff --git a/compiler/GHC/Llvm/MetaData.hs b/compiler/GHC/Llvm/MetaData.hs
new file mode 100644
index 0000000000..3e319c7036
--- /dev/null
+++ b/compiler/GHC/Llvm/MetaData.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module GHC.Llvm.MetaData where
+
+import GhcPrelude
+
+import GHC.Llvm.Types
+import Outputable
+
+-- The LLVM Metadata System.
+--
+-- The LLVM metadata feature is poorly documented but roughly follows the
+-- following design:
+-- * Metadata can be constructed in a few different ways (See below).
+-- * After which it can either be attached to LLVM statements to pass along
+-- extra information to the optimizer and code generator OR specifically named
+-- metadata has an affect on the whole module (i.e., linking behaviour).
+--
+--
+-- # Constructing metadata
+-- Metadata comes largely in three forms:
+--
+-- * Metadata expressions -- these are the raw metadata values that encode
+--   information. They consist of metadata strings, metadata nodes, regular
+--   LLVM values (both literals and references to global variables) and
+--   metadata expressions (i.e., recursive data type). Some examples:
+--     !{ !"hello", !0, i32 0 }
+--     !{ !1, !{ i32 0 } }
+--
+-- * Metadata nodes -- global metadata variables that attach a metadata
+--   expression to a number. For example:
+--     !0 = !{ [<metadata expressions>] !}
+--
+-- * Named metadata -- global metadata variables that attach a metadata nodes
+--   to a name. Used ONLY to communicated module level information to LLVM
+--   through a meaningful name. For example:
+--     !llvm.module.linkage = !{ !0, !1 }
+--
+--
+-- # Using Metadata
+-- Using metadata depends on the form it is in:
+--
+-- * Attach to instructions -- metadata can be attached to LLVM instructions
+--   using a specific reference as follows:
+--     %l = load i32* @glob, !nontemporal !10
+--     %m = load i32* @glob, !nontemporal !{ i32 0, !{ i32 0 } }
+--   Only metadata nodes or expressions can be attached, named metadata cannot.
+--   Refer to LLVM documentation for which instructions take metadata and its
+--   meaning.
+--
+-- * As arguments -- llvm functions can take metadata as arguments, for
+--   example:
+--     call void @llvm.dbg.value(metadata !{ i32 0 }, i64 0, metadata !1)
+--   As with instructions, only metadata nodes or expressions can be attached.
+--
+-- * As a named metadata -- Here the metadata is simply declared in global
+--   scope using a specific name to communicate module level information to LLVM.
+--   For example:
+--     !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 !MetaId
+              | MetaVar !LlvmVar
+              | 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
+               deriving (Eq)
+
+-- | Metadata declarations. Metadata can only be declared in global scope.
+data MetaDecl
+    -- | Named metadata. Only used for communicating module information to
+    -- LLVM. ('!name = !{ [!<n>] }' form).
+    = MetaNamed !LMString [MetaId]
+    -- | Metadata node declaration.
+    -- ('!0 = metadata !{ <metadata expression> }' form).
+    | MetaUnnamed !MetaId !MetaExpr
diff --git a/compiler/GHC/Llvm/Ppr.hs b/compiler/GHC/Llvm/Ppr.hs
new file mode 100644
index 0000000000..0e8d279a50
--- /dev/null
+++ b/compiler/GHC/Llvm/Ppr.hs
@@ -0,0 +1,499 @@
+{-# LANGUAGE CPP #-}
+
+--------------------------------------------------------------------------------
+-- | Pretty print LLVM IR Code.
+--
+
+module GHC.Llvm.Ppr (
+
+    -- * Top level LLVM objects.
+    ppLlvmModule,
+    ppLlvmComments,
+    ppLlvmComment,
+    ppLlvmGlobals,
+    ppLlvmGlobal,
+    ppLlvmAliases,
+    ppLlvmAlias,
+    ppLlvmMetas,
+    ppLlvmMeta,
+    ppLlvmFunctionDecls,
+    ppLlvmFunctionDecl,
+    ppLlvmFunctions,
+    ppLlvmFunction,
+
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Llvm.Syntax
+import GHC.Llvm.MetaData
+import GHC.Llvm.Types
+
+import Data.List ( intersperse )
+import Outputable
+import Unique
+import FastString ( sLit )
+
+--------------------------------------------------------------------------------
+-- * Top Level Print functions
+--------------------------------------------------------------------------------
+
+-- | Print out a whole LLVM module.
+ppLlvmModule :: LlvmModule -> SDoc
+ppLlvmModule (LlvmModule comments aliases meta globals decls funcs)
+  = ppLlvmComments comments $+$ newLine
+    $+$ ppLlvmAliases aliases $+$ newLine
+    $+$ ppLlvmMetas meta $+$ newLine
+    $+$ ppLlvmGlobals globals $+$ newLine
+    $+$ ppLlvmFunctionDecls decls $+$ newLine
+    $+$ ppLlvmFunctions funcs
+
+-- | Print out a multi-line comment, can be inside a function or on its own
+ppLlvmComments :: [LMString] -> SDoc
+ppLlvmComments comments = vcat $ map ppLlvmComment comments
+
+-- | Print out a comment, can be inside a function or on its own
+ppLlvmComment :: LMString -> SDoc
+ppLlvmComment com = semi <+> ftext com
+
+
+-- | Print out a list of global mutable variable definitions
+ppLlvmGlobals :: [LMGlobal] -> SDoc
+ppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls
+
+-- | Print out a global mutable variable definition
+ppLlvmGlobal :: LMGlobal -> SDoc
+ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
+    let sect = case x of
+            Just x' -> text ", section" <+> doubleQuotes (ftext x')
+            Nothing -> empty
+
+        align = case a of
+            Just a' -> text ", align" <+> int a'
+            Nothing -> empty
+
+        rhs = case dat of
+            Just stat -> pprSpecialStatic stat
+            Nothing   -> ppr (pLower $ getVarType var)
+
+        -- Position of linkage is different for aliases.
+        const = case c of
+          Global   -> "global"
+          Constant -> "constant"
+          Alias    -> "alias"
+
+    in ppAssignment var $ ppr link <+> text const <+> rhs <> sect <> align
+       $+$ newLine
+
+ppLlvmGlobal (LMGlobal var val) = sdocWithDynFlags $ \dflags ->
+  error $ "Non Global var ppr as global! "
+          ++ showSDoc dflags (ppr var) ++ " " ++ showSDoc dflags (ppr val)
+
+
+-- | Print out a list of LLVM type aliases.
+ppLlvmAliases :: [LlvmAlias] -> SDoc
+ppLlvmAliases tys = vcat $ map ppLlvmAlias tys
+
+-- | Print out an LLVM type alias.
+ppLlvmAlias :: LlvmAlias -> SDoc
+ppLlvmAlias (name, ty)
+  = char '%' <> ftext name <+> equals <+> text "type" <+> ppr ty
+
+
+-- | Print out a list of LLVM metadata.
+ppLlvmMetas :: [MetaDecl] -> SDoc
+ppLlvmMetas metas = vcat $ map ppLlvmMeta metas
+
+-- | Print out an LLVM metadata definition.
+ppLlvmMeta :: MetaDecl -> SDoc
+ppLlvmMeta (MetaUnnamed n m)
+  = ppr n <+> equals <+> ppr m
+
+ppLlvmMeta (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 :: LlvmFunctions -> SDoc
+ppLlvmFunctions funcs = vcat $ map ppLlvmFunction funcs
+
+-- | Print out a function definition.
+ppLlvmFunction :: LlvmFunction -> SDoc
+ppLlvmFunction 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
+                        Nothing -> empty
+    in text "define" <+> ppLlvmFunctionHeader (funcDecl fun) (funcArgs fun)
+        <+> attrDoc <+> secDoc <+> prefixDoc
+        $+$ lbrace
+        $+$ ppLlvmBlocks (funcBody fun)
+        $+$ rbrace
+        $+$ newLine
+        $+$ newLine
+
+-- | Print out a function definition header.
+ppLlvmFunctionHeader :: LlvmFunctionDecl -> [LMString] -> SDoc
+ppLlvmFunctionHeader (LlvmFunctionDecl n l c r varg p a) args
+  = let varg' = case varg of
+                      VarArgs | null p    -> sLit "..."
+                              | otherwise -> sLit ", ..."
+                      _otherwise          -> sLit ""
+        align = case a of
+                     Just a' -> text " align " <> ppr a'
+                     Nothing -> empty
+        args' = map (\((ty,p),n) -> ppr ty <+> ppSpaceJoin p <+> char '%'
+                                    <> ftext n)
+                    (zip p args)
+    in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <> lparen <>
+        (hsep $ punctuate comma args') <> ptext varg' <> rparen <> align
+
+-- | Print out a list of function declaration.
+ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc
+ppLlvmFunctionDecls decs = vcat $ map ppLlvmFunctionDecl decs
+
+-- | Print out a function declaration.
+-- Declarations define the function type but don't define the actual body of
+-- the function.
+ppLlvmFunctionDecl :: LlvmFunctionDecl -> SDoc
+ppLlvmFunctionDecl (LlvmFunctionDecl n l c r varg p a)
+  = let varg' = case varg of
+                      VarArgs | null p    -> sLit "..."
+                              | otherwise -> sLit ", ..."
+                      _otherwise          -> sLit ""
+        align = case a of
+                     Just a' -> text " align" <+> ppr a'
+                     Nothing -> empty
+        args = hcat $ intersperse (comma <> space) $
+                  map (\(t,a) -> ppr t <+> ppSpaceJoin a) p
+    in text "declare" <+> ppr l <+> ppr c <+> ppr r <+> char '@' <>
+        ftext n <> lparen <> args <> ptext varg' <> rparen <> align $+$ newLine
+
+
+-- | Print out a list of LLVM blocks.
+ppLlvmBlocks :: LlvmBlocks -> SDoc
+ppLlvmBlocks blocks = vcat $ map ppLlvmBlock blocks
+
+-- | Print out an LLVM block.
+-- It must be part of a function definition.
+ppLlvmBlock :: LlvmBlock -> SDoc
+ppLlvmBlock (LlvmBlock blockId stmts) =
+  let isLabel (MkLabel _) = True
+      isLabel _           = False
+      (block, rest)       = break isLabel stmts
+      ppRest = case rest of
+        MkLabel id:xs -> ppLlvmBlock (LlvmBlock id xs)
+        _             -> empty
+  in ppLlvmBlockLabel blockId
+           $+$ (vcat $ map ppLlvmStatement block)
+           $+$ newLine
+           $+$ ppRest
+
+-- | Print out an LLVM block label.
+ppLlvmBlockLabel :: LlvmBlockId -> SDoc
+ppLlvmBlockLabel id = pprUniqueAlways id <> colon
+
+
+-- | Print out an LLVM statement.
+ppLlvmStatement :: LlvmStatement -> SDoc
+ppLlvmStatement stmt =
+  let ind = (text "  " <>)
+  in case stmt of
+        Assignment  dst expr      -> ind $ ppAssignment dst (ppLlvmExpression expr)
+        Fence       st ord        -> ind $ ppFence st ord
+        Branch      target        -> ind $ ppBranch target
+        BranchIf    cond ifT ifF  -> ind $ ppBranchIf 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 expr
+        Unreachable               -> ind $ text "unreachable"
+        Nop                       -> empty
+        MetaStmt    meta s        -> ppMetaStatement meta s
+
+
+-- | Print out an LLVM expression.
+ppLlvmExpression :: LlvmExpression -> SDoc
+ppLlvmExpression 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 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 meta expr
+
+
+--------------------------------------------------------------------------------
+-- * Individual print functions
+--------------------------------------------------------------------------------
+
+-- | 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
+                           --
+    -- if local var function pointer, unwrap
+    LMLocalVar _ (LMPointer (LMFunction d)) -> ppCall' d
+
+    -- should be function type otherwise
+    LMGlobalVar _ (LMFunction d) _ _ _ _    -> ppCall' d
+
+    -- not pointer or function, so error
+    _other -> error $ "ppCall called with non LMFunction type!\nMust be "
+                ++ " called with either global var of function type or "
+                ++ "local var of pointer function type."
+
+    where
+        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) <>
+                           (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
+                    <+> 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
+
+ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
+ppMachOp op left right =
+  (ppr op) <+> (ppr (getVarType left)) <+> ppName left
+        <> comma <+> ppName right
+
+
+ppCmpOp :: LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
+ppCmpOp op left right =
+  let cmpOp
+        | isInt (getVarType left) && isInt (getVarType right) = text "icmp"
+        | isFloat (getVarType left) && isFloat (getVarType right) = text "fcmp"
+        | otherwise = text "icmp" -- Just continue as its much easier to debug
+        {-
+        | otherwise = error ("can't compare different types, left = "
+                ++ (show $ getVarType left) ++ ", right = "
+                ++ (show $ getVarType right))
+        -}
+  in cmpOp <+> ppr op <+> ppr (getVarType left)
+        <+> ppName left <> comma <+> ppName right
+
+
+ppAssignment :: LlvmVar -> SDoc -> SDoc
+ppAssignment var expr = ppName var <+> equals <+> expr
+
+ppFence :: Bool -> LlvmSyncOrdering -> SDoc
+ppFence st ord =
+  let singleThread = case st of True  -> text "singlethread"
+                                False -> empty
+  in text "fence" <+> singleThread <+> ppSyncOrdering ord
+
+ppSyncOrdering :: LlvmSyncOrdering -> SDoc
+ppSyncOrdering SyncUnord     = text "unordered"
+ppSyncOrdering SyncMonotonic = text "monotonic"
+ppSyncOrdering SyncAcquire   = text "acquire"
+ppSyncOrdering SyncRelease   = text "release"
+ppSyncOrdering SyncAcqRel    = text "acq_rel"
+ppSyncOrdering SyncSeqCst    = text "seq_cst"
+
+ppAtomicOp :: LlvmAtomicOp -> SDoc
+ppAtomicOp LAO_Xchg = text "xchg"
+ppAtomicOp LAO_Add  = text "add"
+ppAtomicOp LAO_Sub  = text "sub"
+ppAtomicOp LAO_And  = text "and"
+ppAtomicOp LAO_Nand = text "nand"
+ppAtomicOp LAO_Or   = text "or"
+ppAtomicOp LAO_Xor  = text "xor"
+ppAtomicOp LAO_Max  = text "max"
+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
+
+ppCmpXChg :: LlvmVar -> LlvmVar -> LlvmVar
+          -> LlvmSyncOrdering -> LlvmSyncOrdering -> SDoc
+ppCmpXChg addr old new s_ord f_ord =
+  text "cmpxchg" <+> ppr addr <> comma <+> ppr old <> comma <+> ppr new
+  <+> ppSyncOrdering s_ord <+> ppSyncOrdering f_ord
+
+-- XXX: On x86, vector types need to be 16-byte aligned for aligned access, but
+-- we have no way of guaranteeing that this is true with GHC (we would need to
+-- modify the layout of the stack and closures, change the storage manager,
+-- etc.). So, we blindly tell LLVM that *any* vector store or load could be
+-- unaligned. In the future we may be able to guarantee that certain vector
+-- 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
+  where
+    derefType = pLower $ getVarType var
+    align | isVector . pLower . getVarType $ var = text ", align 1"
+          | otherwise = empty
+
+ppALoad :: LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc
+ppALoad ord st var = sdocWithDynFlags $ \dflags ->
+  let alignment = (llvmWidthInBits dflags $ 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
+            <+> ppSyncOrdering ord <> align
+
+ppStore :: LlvmVar -> LlvmVar -> SDoc
+ppStore val dst
+    | isVecPtrVar dst = text "store" <+> ppr val <> comma <+> ppr dst <>
+                        comma <+> text "align 1"
+    | otherwise       = text "store" <+> ppr val <> comma <+> ppr dst
+  where
+    isVecPtrVar :: LlvmVar -> Bool
+    isVecPtrVar = isVector . pLower . getVarType
+
+
+ppCast :: LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
+ppCast op from to
+    =   ppr op
+    <+> ppr (getVarType from) <+> ppName from
+    <+> text "to"
+    <+> ppr to
+
+
+ppMalloc :: LlvmType -> Int -> SDoc
+ppMalloc tp amount =
+  let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
+  in text "malloc" <+> ppr tp <> comma <+> ppr amount'
+
+
+ppAlloca :: LlvmType -> Int -> SDoc
+ppAlloca tp amount =
+  let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
+  in text "alloca" <+> ppr tp <> comma <+> ppr amount'
+
+
+ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc
+ppGetElementPtr inb ptr idx =
+  let indexes = comma <+> ppCommaJoin idx
+      inbound = if inb then text "inbounds" else empty
+      derefType = pLower $ getVarType ptr
+  in text "getelementptr" <+> inbound <+> ppr derefType <> comma <+> ppr ptr
+                            <> indexes
+
+
+ppReturn :: Maybe LlvmVar -> SDoc
+ppReturn (Just var) = text "ret" <+> ppr var
+ppReturn Nothing    = text "ret" <+> ppr LMVoid
+
+
+ppBranch :: LlvmVar -> SDoc
+ppBranch var = text "br" <+> ppr var
+
+
+ppBranchIf :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
+ppBranchIf cond trueT falseT
+  = text "br" <+> ppr cond <> comma <+> ppr trueT <> comma <+> ppr falseT
+
+
+ppPhi :: LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc
+ppPhi tp preds =
+  let ppPreds (val, label) = brackets $ ppName val <> comma <+> ppName 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
+      ppTargets  xs        = brackets $ vcat (map ppTarget xs)
+  in text "switch" <+> ppr scrut <> comma <+> ppr dflt
+        <+> ppTargets targets
+
+
+ppAsm :: LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
+ppAsm asm constraints rty vars sideeffect alignstack =
+  let asm'  = doubleQuotes $ ftext asm
+      cons  = doubleQuotes $ ftext constraints
+      rty'  = ppr rty
+      vars' = lparen <+> ppCommaJoin 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 =
+    text "extractelement"
+    <+> ppr (getVarType vec) <+> ppName vec <> comma
+    <+> ppr idx
+
+ppExtractV :: LlvmVar -> Int -> SDoc
+ppExtractV struct idx =
+    text "extractvalue"
+    <+> ppr (getVarType struct) <+> ppName struct <> comma
+    <+> ppr idx
+
+ppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
+ppInsert vec elt idx =
+    text "insertelement"
+    <+> ppr (getVarType vec) <+> ppName vec <> comma
+    <+> ppr (getVarType elt) <+> ppName elt <> comma
+    <+> ppr idx
+
+
+ppMetaStatement :: [MetaAnnot] -> LlvmStatement -> SDoc
+ppMetaStatement meta stmt = ppLlvmStatement stmt <> ppMetaAnnots meta
+
+ppMetaExpr :: [MetaAnnot] -> LlvmExpression -> SDoc
+ppMetaExpr meta expr = ppLlvmExpression expr <> ppMetaAnnots meta
+
+ppMetaAnnots :: [MetaAnnot] -> SDoc
+ppMetaAnnots 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?
+
+
+--------------------------------------------------------------------------------
+-- * Misc functions
+--------------------------------------------------------------------------------
+
+-- | Blank line.
+newLine :: SDoc
+newLine = empty
+
+-- | Exclamation point.
+exclamation :: SDoc
+exclamation = char '!'
diff --git a/compiler/GHC/Llvm/Syntax.hs b/compiler/GHC/Llvm/Syntax.hs
new file mode 100644
index 0000000000..d048215a0b
--- /dev/null
+++ b/compiler/GHC/Llvm/Syntax.hs
@@ -0,0 +1,352 @@
+--------------------------------------------------------------------------------
+-- | The LLVM abstract syntax.
+--
+
+module GHC.Llvm.Syntax where
+
+import GhcPrelude
+
+import GHC.Llvm.MetaData
+import GHC.Llvm.Types
+
+import Unique
+
+-- | Block labels
+type LlvmBlockId = Unique
+
+-- | A block of LLVM code.
+data LlvmBlock = LlvmBlock {
+    -- | The code label for this block
+    blockLabel :: LlvmBlockId,
+
+    -- | A list of LlvmStatement's representing the code for this block.
+    -- This list must end with a control flow statement.
+    blockStmts :: [LlvmStatement]
+  }
+
+type LlvmBlocks = [LlvmBlock]
+
+-- | An LLVM Module. This is a top level container in LLVM.
+data LlvmModule = LlvmModule  {
+    -- | Comments to include at the start of the module.
+    modComments  :: [LMString],
+
+    -- | LLVM Alias type definitions.
+    modAliases   :: [LlvmAlias],
+
+    -- | LLVM meta data.
+    modMeta      :: [MetaDecl],
+
+    -- | Global variables to include in the module.
+    modGlobals   :: [LMGlobal],
+
+    -- | LLVM Functions used in this module but defined in other modules.
+    modFwdDecls  :: LlvmFunctionDecls,
+
+    -- | LLVM Functions defined in this module.
+    modFuncs     :: LlvmFunctions
+  }
+
+-- | An LLVM Function
+data LlvmFunction = LlvmFunction {
+    -- | The signature of this declared function.
+    funcDecl      :: LlvmFunctionDecl,
+
+    -- | The functions arguments
+    funcArgs      :: [LMString],
+
+    -- | The function attributes.
+    funcAttrs     :: [LlvmFuncAttr],
+
+    -- | The section to put the function into,
+    funcSect      :: LMSection,
+
+    -- | Prefix data
+    funcPrefix    :: Maybe LlvmStatic,
+
+    -- | The body of the functions.
+    funcBody      :: LlvmBlocks
+  }
+
+type LlvmFunctions = [LlvmFunction]
+
+type SingleThreaded = Bool
+
+-- | LLVM ordering types for synchronization purposes. (Introduced in LLVM
+-- 3.0). Please see the LLVM documentation for a better description.
+data LlvmSyncOrdering
+  -- | Some partial order of operations exists.
+  = SyncUnord
+  -- | A single total order for operations at a single address exists.
+  | SyncMonotonic
+  -- | Acquire synchronization operation.
+  | SyncAcquire
+  -- | Release synchronization operation.
+  | SyncRelease
+  -- | Acquire + Release synchronization operation.
+  | SyncAcqRel
+  -- | Full sequential Consistency operation.
+  | SyncSeqCst
+  deriving (Show, Eq)
+
+-- | LLVM atomic operations. Please see the @atomicrmw@ instruction in
+-- the LLVM documentation for a complete description.
+data LlvmAtomicOp
+  = LAO_Xchg
+  | LAO_Add
+  | LAO_Sub
+  | LAO_And
+  | LAO_Nand
+  | LAO_Or
+  | LAO_Xor
+  | LAO_Max
+  | LAO_Min
+  | LAO_Umax
+  | LAO_Umin
+  deriving (Show, Eq)
+
+-- | Llvm Statements
+data LlvmStatement
+  {- |
+    Assign an expression to a variable:
+      * dest:   Variable to assign to
+      * source: Source expression
+  -}
+  = Assignment LlvmVar LlvmExpression
+
+  {- |
+    Memory fence operation
+  -}
+  | Fence Bool LlvmSyncOrdering
+
+  {- |
+    Always branch to the target label
+  -}
+  | Branch LlvmVar
+
+  {- |
+    Branch to label targetTrue if cond is true otherwise to label targetFalse
+      * cond:        condition that will be tested, must be of type i1
+      * targetTrue:  label to branch to if cond is true
+      * targetFalse: label to branch to if cond is false
+  -}
+  | BranchIf LlvmVar LlvmVar LlvmVar
+
+  {- |
+    Comment
+    Plain comment.
+  -}
+  | Comment [LMString]
+
+  {- |
+    Set a label on this position.
+      * name: Identifier of this label, unique for this module
+  -}
+  | MkLabel LlvmBlockId
+
+  {- |
+    Store variable value in pointer ptr. If value is of type t then ptr must
+    be of type t*.
+      * value: Variable/Constant to store.
+      * ptr:   Location to store the value in
+  -}
+  | Store LlvmVar LlvmVar
+
+  {- |
+    Multiway branch
+      * scrutinee: Variable or constant which must be of integer type that is
+                   determines which arm is chosen.
+      * def:       The default label if there is no match in target.
+      * target:    A list of (value,label) where the value is an integer
+                   constant and label the corresponding label to jump to if the
+                   scrutinee matches the value.
+  -}
+  | Switch LlvmVar LlvmVar [(LlvmVar, LlvmVar)]
+
+  {- |
+    Return a result.
+      * result: The variable or constant to return
+  -}
+  | Return (Maybe LlvmVar)
+
+  {- |
+    An instruction for the optimizer that the code following is not reachable
+  -}
+  | Unreachable
+
+  {- |
+    Raise an expression to a statement (if don't want result or want to use
+    Llvm unnamed values.
+  -}
+  | Expr LlvmExpression
+
+  {- |
+    A nop LLVM statement. Useful as its often more efficient to use this
+    then to wrap LLvmStatement in a Just or [].
+  -}
+  | Nop
+
+  {- |
+    A LLVM statement with metadata attached to it.
+  -}
+  | MetaStmt [MetaAnnot] LlvmStatement
+
+  deriving (Eq)
+
+
+-- | Llvm Expressions
+data LlvmExpression
+  {- |
+    Allocate amount * sizeof(tp) bytes on the stack
+      * tp:     LlvmType to reserve room for
+      * amount: The nr of tp's which must be allocated
+  -}
+  = Alloca LlvmType Int
+
+  {- |
+    Perform the machine operator op on the operands left and right
+      * op:    operator
+      * left:  left operand
+      * right: right operand
+  -}
+  | LlvmOp LlvmMachOp LlvmVar LlvmVar
+
+  {- |
+    Perform a compare operation on the operands left and right
+      * op:    operator
+      * left:  left operand
+      * right: right operand
+  -}
+  | Compare LlvmCmpOp LlvmVar LlvmVar
+
+  {- |
+    Extract a scalar element from a vector
+      * val: The vector
+      * idx: The index of the scalar within the vector
+  -}
+  | Extract LlvmVar LlvmVar
+
+  {- |
+    Extract a scalar element from a structure
+      * val: The structure
+      * idx: The index of the scalar within the structure
+    Corresponds to "extractvalue" instruction.
+  -}
+  | ExtractV LlvmVar Int
+
+  {- |
+    Insert a scalar element into a vector
+      * val:   The source vector
+      * elt:   The scalar to insert
+      * index: The index at which to insert the scalar
+  -}
+  | Insert LlvmVar LlvmVar LlvmVar
+
+  {- |
+    Allocate amount * sizeof(tp) bytes on the heap
+      * tp:     LlvmType to reserve room for
+      * amount: The nr of tp's which must be allocated
+  -}
+  | Malloc LlvmType Int
+
+  {- |
+    Load the value at location ptr
+  -}
+  | Load LlvmVar
+
+  {- |
+    Atomic load of the value at location ptr
+  -}
+  | ALoad LlvmSyncOrdering SingleThreaded LlvmVar
+
+  {- |
+    Navigate in a structure, selecting elements
+      * inbound: Is the pointer inbounds? (computed pointer doesn't overflow)
+      * ptr:     Location of the structure
+      * indexes: A list of indexes to select the correct value.
+  -}
+  | GetElemPtr Bool LlvmVar [LlvmVar]
+
+  {- |
+    Cast the variable from to the to type. This is an abstraction of three
+    cast operators in Llvm, inttoptr, ptrtoint and bitcast.
+       * cast: Cast type
+       * from: Variable to cast
+       * to:   type to cast to
+  -}
+  | Cast LlvmCastOp LlvmVar LlvmType
+
+  {- |
+    Atomic read-modify-write operation
+       * op:       Atomic operation
+       * addr:     Address to modify
+       * operand:  Operand to operation
+       * ordering: Ordering requirement
+  -}
+  | AtomicRMW LlvmAtomicOp LlvmVar LlvmVar LlvmSyncOrdering
+
+  {- |
+    Compare-and-exchange operation
+       * addr:     Address to modify
+       * old:      Expected value
+       * new:      New value
+       * suc_ord:  Ordering required in success case
+       * fail_ord: Ordering required in failure case, can be no stronger than
+                   suc_ord
+
+    Result is an @i1@, true if store was successful.
+  -}
+  | CmpXChg LlvmVar LlvmVar LlvmVar LlvmSyncOrdering LlvmSyncOrdering
+
+  {- |
+    Call a function. The result is the value of the expression.
+      * tailJumps: CallType to signal if the function should be tail called
+      * fnptrval:  An LLVM value containing a pointer to a function to be
+                   invoked. Can be indirect. Should be LMFunction type.
+      * args:      Concrete arguments for the parameters
+      * attrs:     A list of function attributes for the call. Only NoReturn,
+                   NoUnwind, ReadOnly and ReadNone are valid here.
+  -}
+  | Call LlvmCallType LlvmVar [LlvmVar] [LlvmFuncAttr]
+
+  {- |
+    Call a function as above but potentially taking metadata as arguments.
+      * tailJumps: CallType to signal if the function should be tail called
+      * fnptrval:  An LLVM value containing a pointer to a function to be
+                   invoked. Can be indirect. Should be LMFunction type.
+      * args:      Arguments that may include metadata.
+      * attrs:     A list of function attributes for the call. Only NoReturn,
+                   NoUnwind, ReadOnly and ReadNone are valid here.
+  -}
+  | CallM LlvmCallType LlvmVar [MetaExpr] [LlvmFuncAttr]
+
+  {- |
+    Merge variables from different basic blocks which are predecessors of this
+    basic block in a new variable of type tp.
+      * tp:         type of the merged variable, must match the types of the
+                    predecessor variables.
+      * predecessors: A list of variables and the basic block that they originate
+                      from.
+  -}
+  | Phi LlvmType [(LlvmVar,LlvmVar)]
+
+  {- |
+    Inline assembly expression. Syntax is very similar to the style used by GCC.
+      * assembly:    Actual inline assembly code.
+      * constraints: Operand constraints.
+      * return ty:   Return type of function.
+      * vars:        Any variables involved in the assembly code.
+      * sideeffect:  Does the expression have side effects not visible from the
+                     constraints list.
+      * alignstack:  Should the stack be conservatively aligned before this
+                     expression is executed.
+  -}
+  | Asm LMString LMString LlvmType [LlvmVar] Bool Bool
+
+  {- |
+    A LLVM expression with metadata attached to it.
+  -}
+  | MExpr [MetaAnnot] LlvmExpression
+
+  deriving (Eq)
+
diff --git a/compiler/GHC/Llvm/Types.hs b/compiler/GHC/Llvm/Types.hs
new file mode 100644
index 0000000000..f4fa9a9a56
--- /dev/null
+++ b/compiler/GHC/Llvm/Types.hs
@@ -0,0 +1,888 @@
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
+
+--------------------------------------------------------------------------------
+-- | The LLVM Type System.
+--
+
+module GHC.Llvm.Types where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import Data.Char
+import Data.Int
+import Numeric
+
+import DynFlags
+import FastString
+import Outputable
+import Unique
+
+-- from NCG
+import PprBase
+
+import GHC.Float
+
+-- -----------------------------------------------------------------------------
+-- * LLVM Basic Types and Variables
+--
+
+-- | A global mutable variable. Maybe defined or external
+data LMGlobal = LMGlobal {
+  getGlobalVar :: LlvmVar,          -- ^ Returns the variable of the 'LMGlobal'
+  getGlobalValue :: Maybe LlvmStatic -- ^ Return the value of the 'LMGlobal'
+  }
+
+-- | A String in LLVM
+type LMString = FastString
+
+-- | A type alias
+type LlvmAlias = (LMString, LlvmType)
+
+-- | Llvm Types
+data LlvmType
+  = LMInt Int             -- ^ An integer with a given width in bits.
+  | LMFloat               -- ^ 32 bit floating point
+  | LMDouble              -- ^ 64 bit floating point
+  | LMFloat80             -- ^ 80 bit (x86 only) floating point
+  | LMFloat128            -- ^ 128 bit floating point
+  | LMPointer LlvmType    -- ^ A pointer to a 'LlvmType'
+  | LMArray Int LlvmType  -- ^ An array of 'LlvmType'
+  | LMVector Int LlvmType -- ^ A vector of 'LlvmType'
+  | LMLabel               -- ^ A 'LlvmVar' can represent a label (address)
+  | LMVoid                -- ^ Void type
+  | LMStruct [LlvmType]   -- ^ Packed structure type
+  | LMStructU [LlvmType]  -- ^ Unpacked structure type
+  | LMAlias LlvmAlias     -- ^ A type alias
+  | LMMetadata            -- ^ LLVM Metadata
+
+  -- | Function type, used to create pointers to functions
+  | LMFunction LlvmFunctionDecl
+  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
+
+ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
+ppParams varg p
+  = let varg' = case varg of
+          VarArgs | null args -> sLit "..."
+                  | otherwise -> sLit ", ..."
+          _otherwise          -> sLit ""
+        -- by default we don't print param attributes
+        args = map fst p
+    in ppCommaJoin args <> ptext varg'
+
+-- | An LLVM section definition. If Nothing then let LLVM decide the section
+type LMSection = Maybe LMString
+type LMAlign = Maybe Int
+
+data LMConst = Global      -- ^ Mutable global variable
+             | Constant    -- ^ Constant global variable
+             | Alias       -- ^ Alias of another variable
+             deriving (Eq)
+
+-- | LLVM Variables
+data LlvmVar
+  -- | Variables with a global scope.
+  = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign LMConst
+  -- | Variables local to a function or parameters.
+  | LMLocalVar Unique LlvmType
+  -- | Named local variables. Sometimes we need to be able to explicitly name
+  -- variables (e.g for function arguments).
+  | LMNLocalVar LMString LlvmType
+  -- | A constant variable
+  | 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.
+data LlvmLit
+  -- | Refers to an integer constant (i64 42).
+  = LMIntLit Integer LlvmType
+  -- | Floating point literal
+  | LMFloatLit Double LlvmType
+  -- | Literal NULL, only applicable to pointer types
+  | LMNullLit LlvmType
+  -- | Vector literal
+  | LMVectorLit [LlvmLit]
+  -- | Undefined value, random bit pattern. Useful for optimisations.
+  | 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.
+data LlvmStatic
+  = LMComment LMString                  -- ^ A comment in a static section
+  | LMStaticLit LlvmLit                 -- ^ A static variant of a literal value
+  | LMUninitType LlvmType               -- ^ For uninitialised data
+  | LMStaticStr LMString LlvmType       -- ^ Defines a static 'LMString'
+  | LMStaticArray [LlvmStatic] LlvmType -- ^ A static array
+  | LMStaticStruc [LlvmStatic] LlvmType -- ^ A static structure type
+  | LMStaticPointer LlvmVar             -- ^ A pointer to other data
+
+  -- static expressions, could split out but leave
+  -- for moment for ease of use. Not many of them.
+
+  | LMTrunc LlvmStatic LlvmType        -- ^ Truncate
+  | LMBitc LlvmStatic LlvmType         -- ^ Pointer to Pointer conversion
+  | LMPtoI LlvmStatic LlvmType         -- ^ Pointer to Integer conversion
+  | 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 sdocWithDynFlags $ \dflags ->
+            error $ op_name ++ " with different types! s1: "
+                    ++ showSDoc dflags (ppr s1) ++ ", s2: " ++ showSDoc dflags (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 (LMIntLit i (LMInt 32))  = ppr (fromInteger i :: Int32)
+ppLit (LMIntLit i (LMInt 64))  = ppr (fromInteger i :: Int64)
+ppLit (LMIntLit   i _       )  = ppr ((fromInteger i)::Int)
+ppLit (LMFloatLit r LMFloat )  = ppFloat $ narrowFp r
+ppLit (LMFloatLit r LMDouble)  = ppDouble r
+ppLit f@(LMFloatLit _ _)       = sdocWithDynFlags (\dflags ->
+                                   error $ "Can't print this float literal!" ++ showSDoc dflags (ppr f))
+ppLit (LMVectorLit ls  )       = char '<' <+> ppCommaJoin ls <+> char '>'
+ppLit (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.
+ppLit (LMUndefLit t    )       = sdocWithDynFlags f
+  where f dflags
+          | gopt Opt_LlvmFillUndefWithGarbage dflags,
+            Just lit <- garbageLit t   = ppLit lit
+          | otherwise                  = text "undef"
+
+garbageLit :: LlvmType -> Maybe LlvmLit
+garbageLit t@(LMInt w)     = Just (LMIntLit (0xbbbbbbbbbbbbbbb0 `mod` (2^w)) t)
+  -- Use a value that looks like an untagged pointer, so we are more
+  -- likely to try to enter it
+garbageLit t
+  | isFloat t              = Just (LMFloatLit 12345678.9 t)
+garbageLit t@(LMPointer _) = Just (LMNullLit t)
+  -- Using null isn't totally ideal, since some functions may check for null.
+  -- But producing another value is inconvenient since it needs a cast,
+  -- and the knowledge for how to format casts is in PpLlvm.
+garbageLit _               = Nothing
+  -- More cases could be added, but this should do for now.
+
+-- | Return the 'LlvmType' of the 'LlvmVar'
+getVarType :: LlvmVar -> LlvmType
+getVarType (LMGlobalVar _ y _ _ _ _) = y
+getVarType (LMLocalVar  _ y        ) = y
+getVarType (LMNLocalVar _ y        ) = y
+getVarType (LMLitVar    l          ) = getLitType l
+
+-- | Return the 'LlvmType' of a 'LlvmLit'
+getLitType :: LlvmLit -> LlvmType
+getLitType (LMIntLit   _ t) = t
+getLitType (LMFloatLit _ t) = t
+getLitType (LMVectorLit [])  = panic "getLitType"
+getLitType (LMVectorLit ls)  = LMVector (length ls) (getLitType (head ls))
+getLitType (LMNullLit    t) = t
+getLitType (LMUndefLit   t) = t
+
+-- | Return the 'LlvmType' of the 'LlvmStatic'
+getStatType :: LlvmStatic -> LlvmType
+getStatType (LMStaticLit   l  ) = getLitType l
+getStatType (LMUninitType    t) = t
+getStatType (LMStaticStr   _ t) = t
+getStatType (LMStaticArray _ t) = t
+getStatType (LMStaticStruc _ t) = t
+getStatType (LMStaticPointer v) = getVarType v
+getStatType (LMTrunc       _ t) = t
+getStatType (LMBitc        _ t) = t
+getStatType (LMPtoI        _ t) = t
+getStatType (LMAdd         t _) = getStatType t
+getStatType (LMSub         t _) = getStatType t
+getStatType (LMComment       _) = error "Can't call getStatType on LMComment!"
+
+-- | Return the 'LlvmLinkageType' for a 'LlvmVar'
+getLink :: LlvmVar -> LlvmLinkageType
+getLink (LMGlobalVar _ _ l _ _ _) = l
+getLink _                         = Internal
+
+-- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid'
+-- cannot be lifted.
+pLift :: LlvmType -> LlvmType
+pLift LMLabel    = error "Labels are unliftable"
+pLift LMVoid     = error "Voids are unliftable"
+pLift LMMetadata = error "Metadatas are unliftable"
+pLift x          = LMPointer x
+
+-- | Lift a variable to 'LMPointer' type.
+pVarLift :: LlvmVar -> LlvmVar
+pVarLift (LMGlobalVar s t l x a c) = LMGlobalVar s (pLift t) l x a c
+pVarLift (LMLocalVar  s t        ) = LMLocalVar  s (pLift t)
+pVarLift (LMNLocalVar s t        ) = LMNLocalVar s (pLift t)
+pVarLift (LMLitVar    _          ) = error $ "Can't lower a literal type!"
+
+-- | Remove the pointer indirection of the supplied type. Only 'LMPointer'
+-- constructors can be lowered.
+pLower :: LlvmType -> LlvmType
+pLower (LMPointer x) = x
+pLower x  = pprPanic "llvmGen(pLower)"
+            $ ppr x <+> text " is a unlowerable type, need a pointer"
+
+-- | Lower a variable of 'LMPointer' type.
+pVarLower :: LlvmVar -> LlvmVar
+pVarLower (LMGlobalVar s t l x a c) = LMGlobalVar s (pLower t) l x a c
+pVarLower (LMLocalVar  s t        ) = LMLocalVar  s (pLower t)
+pVarLower (LMNLocalVar s t        ) = LMNLocalVar s (pLower t)
+pVarLower (LMLitVar    _          ) = error $ "Can't lower a literal type!"
+
+-- | Test if the given 'LlvmType' is an integer
+isInt :: LlvmType -> Bool
+isInt (LMInt _) = True
+isInt _         = False
+
+-- | Test if the given 'LlvmType' is a floating point type
+isFloat :: LlvmType -> Bool
+isFloat LMFloat    = True
+isFloat LMDouble   = True
+isFloat LMFloat80  = True
+isFloat LMFloat128 = True
+isFloat _          = False
+
+-- | Test if the given 'LlvmType' is an 'LMPointer' construct
+isPointer :: LlvmType -> Bool
+isPointer (LMPointer _) = True
+isPointer _             = False
+
+-- | Test if the given 'LlvmType' is an 'LMVector' construct
+isVector :: LlvmType -> Bool
+isVector (LMVector {}) = True
+isVector _             = False
+
+-- | Test if a 'LlvmVar' is global.
+isGlobal :: LlvmVar -> Bool
+isGlobal (LMGlobalVar _ _ _ _ _ _) = True
+isGlobal _                         = False
+
+-- | Width in bits of an 'LlvmType', returns 0 if not applicable
+llvmWidthInBits :: DynFlags -> LlvmType -> Int
+llvmWidthInBits _      (LMInt n)       = n
+llvmWidthInBits _      (LMFloat)       = 32
+llvmWidthInBits _      (LMDouble)      = 64
+llvmWidthInBits _      (LMFloat80)     = 80
+llvmWidthInBits _      (LMFloat128)    = 128
+-- Could return either a pointer width here or the width of what
+-- it points to. We will go with the former for now.
+-- PMW: At least judging by the way LLVM outputs constants, pointers
+--      should use the former, but arrays the latter.
+llvmWidthInBits dflags (LMPointer _)   = llvmWidthInBits dflags (llvmWord dflags)
+llvmWidthInBits dflags (LMArray n t)   = n * llvmWidthInBits dflags t
+llvmWidthInBits dflags (LMVector n ty) = n * llvmWidthInBits dflags ty
+llvmWidthInBits _      LMLabel         = 0
+llvmWidthInBits _      LMVoid          = 0
+llvmWidthInBits dflags (LMStruct tys)  = sum $ map (llvmWidthInBits dflags) tys
+llvmWidthInBits _      (LMStructU _)   =
+    -- It's not trivial to calculate the bit width of the unpacked structs,
+    -- since they will be aligned depending on the specified datalayout (
+    -- http://llvm.org/docs/LangRef.html#data-layout ). One way we could support
+    -- this could be to make the GHC.CmmToLlvm.Ppr.moduleLayout be a data type
+    -- that exposes the alignment information. However, currently the only place
+    -- we use unpacked structs is LLVM intrinsics that return them (e.g.,
+    -- llvm.sadd.with.overflow.*), so we don't actually need to compute their
+    -- bit width.
+    panic "llvmWidthInBits: not implemented for LMStructU"
+llvmWidthInBits _      (LMFunction  _) = 0
+llvmWidthInBits dflags (LMAlias (_,t)) = llvmWidthInBits dflags t
+llvmWidthInBits _      LMMetadata      = panic "llvmWidthInBits: Meta-data has no runtime representation!"
+
+
+-- -----------------------------------------------------------------------------
+-- ** Shortcut for Common Types
+--
+
+i128, i64, i32, i16, i8, i1, i8Ptr :: LlvmType
+i128  = LMInt 128
+i64   = LMInt  64
+i32   = LMInt  32
+i16   = LMInt  16
+i8    = LMInt   8
+i1    = LMInt   1
+i8Ptr = pLift i8
+
+-- | The target architectures word size
+llvmWord, llvmWordPtr :: DynFlags -> LlvmType
+llvmWord    dflags = LMInt (wORD_SIZE dflags * 8)
+llvmWordPtr dflags = pLift (llvmWord dflags)
+
+-- -----------------------------------------------------------------------------
+-- * LLVM Function Types
+--
+
+-- | An LLVM Function
+data LlvmFunctionDecl = LlvmFunctionDecl {
+        -- | Unique identifier of the function
+        decName       :: LMString,
+        -- | LinkageType of the function
+        funcLinkage   :: LlvmLinkageType,
+        -- | The calling convention of the function
+        funcCc        :: LlvmCallConvention,
+        -- | Type of the returned value
+        decReturnType :: LlvmType,
+        -- | Indicates if this function uses varargs
+        decVarargs    :: LlvmParameterListType,
+        -- | Parameter types and attributes
+        decParams     :: [LlvmParameter],
+        -- | Function align value, must be power of 2
+        funcAlign     :: LMAlign
+  }
+  deriving (Eq)
+
+instance Outputable LlvmFunctionDecl where
+  ppr (LlvmFunctionDecl n l c r varg p a)
+    = let align = case a of
+                       Just a' -> text " align " <> ppr a'
+                       Nothing -> empty
+      in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <>
+             lparen <> ppParams varg p <> rparen <> align
+
+type LlvmFunctionDecls = [LlvmFunctionDecl]
+
+type LlvmParameter = (LlvmType, [LlvmParamAttr])
+
+-- | LLVM Parameter Attributes.
+--
+-- Parameter attributes are used to communicate additional information about
+-- the result or parameters of a function
+data LlvmParamAttr
+  -- | This indicates to the code generator that the parameter or return value
+  -- should be zero-extended to a 32-bit value by the caller (for a parameter)
+  -- or the callee (for a return value).
+  = ZeroExt
+  -- | This indicates to the code generator that the parameter or return value
+  -- should be sign-extended to a 32-bit value by the caller (for a parameter)
+  -- or the callee (for a return value).
+  | SignExt
+  -- | This indicates that this parameter or return value should be treated in
+  -- a special target-dependent fashion during while emitting code for a
+  -- function call or return (usually, by putting it in a register as opposed
+  -- to memory).
+  | InReg
+  -- | This indicates that the pointer parameter should really be passed by
+  -- value to the function.
+  | ByVal
+  -- | This indicates that the pointer parameter specifies the address of a
+  -- structure that is the return value of the function in the source program.
+  | SRet
+  -- | This indicates that the pointer does not alias any global or any other
+  -- parameter.
+  | NoAlias
+  -- | This indicates that the callee does not make any copies of the pointer
+  -- that outlive the callee itself
+  | NoCapture
+  -- | This indicates that the pointer parameter can be excised using the
+  -- trampoline intrinsics.
+  | Nest
+  deriving (Eq)
+
+instance Outputable LlvmParamAttr where
+  ppr ZeroExt   = text "zeroext"
+  ppr SignExt   = text "signext"
+  ppr InReg     = text "inreg"
+  ppr ByVal     = text "byval"
+  ppr SRet      = text "sret"
+  ppr NoAlias   = text "noalias"
+  ppr NoCapture = text "nocapture"
+  ppr Nest      = text "nest"
+
+-- | Llvm Function Attributes.
+--
+-- Function attributes are set to communicate additional information about a
+-- function. Function attributes are considered to be part of the function,
+-- not of the function type, so functions with different parameter attributes
+-- can have the same function type. Functions can have multiple attributes.
+--
+-- Descriptions taken from <http://llvm.org/docs/LangRef.html#fnattrs>
+data LlvmFuncAttr
+  -- | This attribute indicates that the inliner should attempt to inline this
+  -- function into callers whenever possible, ignoring any active inlining
+  -- size threshold for this caller.
+  = AlwaysInline
+  -- | This attribute indicates that the source code contained a hint that
+  -- inlining this function is desirable (such as the \"inline\" keyword in
+  -- C/C++). It is just a hint; it imposes no requirements on the inliner.
+  | InlineHint
+  -- | This attribute indicates that the inliner should never inline this
+  -- function in any situation. This attribute may not be used together
+  -- with the alwaysinline attribute.
+  | NoInline
+  -- | This attribute suggests that optimization passes and code generator
+  -- passes make choices that keep the code size of this function low, and
+  -- otherwise do optimizations specifically to reduce code size.
+  | OptSize
+  -- | This function attribute indicates that the function never returns
+  -- normally. This produces undefined behavior at runtime if the function
+  -- ever does dynamically return.
+  | NoReturn
+  -- | This function attribute indicates that the function never returns with
+  -- an unwind or exceptional control flow. If the function does unwind, its
+  -- runtime behavior is undefined.
+  | NoUnwind
+  -- | This attribute indicates that the function computes its result (or
+  -- decides to unwind an exception) based strictly on its arguments, without
+  -- dereferencing any pointer arguments or otherwise accessing any mutable
+  -- state (e.g. memory, control registers, etc) visible to caller functions.
+  -- It does not write through any pointer arguments (including byval
+  -- arguments) and never changes any state visible to callers. This means
+  -- that it cannot unwind exceptions by calling the C++ exception throwing
+  -- methods, but could use the unwind instruction.
+  | ReadNone
+  -- | This attribute indicates that the function does not write through any
+  -- pointer arguments (including byval arguments) or otherwise modify any
+  -- state (e.g. memory, control registers, etc) visible to caller functions.
+  -- It may dereference pointer arguments and read state that may be set in
+  -- the caller. A readonly function always returns the same value (or unwinds
+  -- an exception identically) when called with the same set of arguments and
+  -- global state. It cannot unwind an exception by calling the C++ exception
+  -- throwing methods, but may use the unwind instruction.
+  | ReadOnly
+  -- | This attribute indicates that the function should emit a stack smashing
+  -- protector. It is in the form of a \"canary\"—a random value placed on the
+  -- stack before the local variables that's checked upon return from the
+  -- function to see if it has been overwritten. A heuristic is used to
+  -- determine if a function needs stack protectors or not.
+  --
+  -- If a function that has an ssp attribute is inlined into a function that
+  -- doesn't have an ssp attribute, then the resulting function will have an
+  -- ssp attribute.
+  | Ssp
+  -- | This attribute indicates that the function should always emit a stack
+  -- smashing protector. This overrides the ssp function attribute.
+  --
+  -- If a function that has an sspreq attribute is inlined into a function
+  -- that doesn't have an sspreq attribute or which has an ssp attribute,
+  -- then the resulting function will have an sspreq attribute.
+  | SspReq
+  -- | This attribute indicates that the code generator should not use a red
+  -- zone, even if the target-specific ABI normally permits it.
+  | NoRedZone
+  -- | This attributes disables implicit floating point instructions.
+  | NoImplicitFloat
+  -- | This attribute disables prologue / epilogue emission for the function.
+  -- This can have very system-specific consequences.
+  | Naked
+  deriving (Eq)
+
+instance Outputable LlvmFuncAttr where
+  ppr AlwaysInline       = text "alwaysinline"
+  ppr InlineHint         = text "inlinehint"
+  ppr NoInline           = text "noinline"
+  ppr OptSize            = text "optsize"
+  ppr NoReturn           = text "noreturn"
+  ppr NoUnwind           = text "nounwind"
+  ppr ReadNone           = text "readnone"
+  ppr ReadOnly           = text "readonly"
+  ppr Ssp                = text "ssp"
+  ppr SspReq             = text "ssqreq"
+  ppr NoRedZone          = text "noredzone"
+  ppr NoImplicitFloat    = text "noimplicitfloat"
+  ppr Naked              = text "naked"
+
+
+-- | Different types to call a function.
+data LlvmCallType
+  -- | Normal call, allocate a new stack frame.
+  = StdCall
+  -- | Tail call, perform the call in the current stack frame.
+  | TailCall
+  deriving (Eq,Show)
+
+-- | Different calling conventions a function can use.
+data LlvmCallConvention
+  -- | The C calling convention.
+  -- This calling convention (the default if no other calling convention is
+  -- specified) matches the target C calling conventions. This calling
+  -- convention supports varargs function calls and tolerates some mismatch in
+  -- the declared prototype and implemented declaration of the function (as
+  -- does normal C).
+  = CC_Ccc
+  -- | This calling convention attempts to make calls as fast as possible
+  -- (e.g. by passing things in registers). This calling convention allows
+  -- the target to use whatever tricks it wants to produce fast code for the
+  -- target, without having to conform to an externally specified ABI
+  -- (Application Binary Interface). Implementations of this convention should
+  -- allow arbitrary tail call optimization to be supported. This calling
+  -- convention does not support varargs and requires the prototype of al
+  -- callees to exactly match the prototype of the function definition.
+  | CC_Fastcc
+  -- | This calling convention attempts to make code in the caller as efficient
+  -- as possible under the assumption that the call is not commonly executed.
+  -- As such, these calls often preserve all registers so that the call does
+  -- not break any live ranges in the caller side. This calling convention
+  -- does not support varargs and requires the prototype of all callees to
+  -- exactly match the prototype of the function definition.
+  | CC_Coldcc
+  -- | The GHC-specific 'registerised' calling convention.
+  | CC_Ghc
+  -- | Any calling convention may be specified by number, allowing
+  -- target-specific calling conventions to be used. Target specific calling
+  -- conventions start at 64.
+  | CC_Ncc Int
+  -- | X86 Specific 'StdCall' convention. LLVM includes a specific alias for it
+  -- rather than just using CC_Ncc.
+  | CC_X86_Stdcc
+  deriving (Eq)
+
+instance Outputable LlvmCallConvention where
+  ppr CC_Ccc       = text "ccc"
+  ppr CC_Fastcc    = text "fastcc"
+  ppr CC_Coldcc    = text "coldcc"
+  ppr CC_Ghc       = text "ghccc"
+  ppr (CC_Ncc i)   = text "cc " <> ppr i
+  ppr CC_X86_Stdcc = text "x86_stdcallcc"
+
+
+-- | Functions can have a fixed amount of parameters, or a variable amount.
+data LlvmParameterListType
+  -- Fixed amount of arguments.
+  = FixedArgs
+  -- Variable amount of arguments.
+  | VarArgs
+  deriving (Eq,Show)
+
+
+-- | Linkage type of a symbol.
+--
+-- The description of the constructors is copied from the Llvm Assembly Language
+-- Reference Manual <http://www.llvm.org/docs/LangRef.html#linkage>, because
+-- they correspond to the Llvm linkage types.
+data LlvmLinkageType
+  -- | Global values with internal linkage are only directly accessible by
+  -- objects in the current module. In particular, linking code into a module
+  -- with an internal global value may cause the internal to be renamed as
+  -- necessary to avoid collisions. Because the symbol is internal to the
+  -- module, all references can be updated. This corresponds to the notion
+  -- of the @static@ keyword in C.
+  = Internal
+  -- | Globals with @linkonce@ linkage are merged with other globals of the
+  -- same name when linkage occurs. This is typically used to implement
+  -- inline functions, templates, or other code which must be generated
+  -- in each translation unit that uses it. Unreferenced linkonce globals are
+  -- allowed to be discarded.
+  | LinkOnce
+  -- | @weak@ linkage is exactly the same as linkonce linkage, except that
+  -- unreferenced weak globals may not be discarded. This is used for globals
+  -- that may be emitted in multiple translation units, but that are not
+  -- guaranteed to be emitted into every translation unit that uses them. One
+  -- example of this are common globals in C, such as @int X;@ at global
+  -- scope.
+  | Weak
+  -- | @appending@ linkage may only be applied to global variables of pointer
+  -- to array type. When two global variables with appending linkage are
+  -- linked together, the two global arrays are appended together. This is
+  -- the Llvm, typesafe, equivalent of having the system linker append
+  -- together @sections@ with identical names when .o files are linked.
+  | Appending
+  -- | The semantics of this linkage follow the ELF model: the symbol is weak
+  -- until linked, if not linked, the symbol becomes null instead of being an
+  -- undefined reference.
+  | ExternWeak
+  -- | The symbol participates in linkage and can be used to resolve external
+  --  symbol references.
+  | ExternallyVisible
+  -- | Alias for 'ExternallyVisible' but with explicit textual form in LLVM
+  --  assembly.
+  | External
+  -- | Symbol is private to the module and should not appear in the symbol table
+  | Private
+  deriving (Eq)
+
+instance Outputable LlvmLinkageType where
+  ppr Internal          = text "internal"
+  ppr LinkOnce          = text "linkonce"
+  ppr Weak              = text "weak"
+  ppr Appending         = text "appending"
+  ppr ExternWeak        = text "extern_weak"
+  -- ExternallyVisible does not have a textual representation, it is
+  -- the linkage type a function resolves to if no other is specified
+  -- in Llvm.
+  ppr ExternallyVisible = empty
+  ppr External          = text "external"
+  ppr Private           = text "private"
+
+-- -----------------------------------------------------------------------------
+-- * LLVM Operations
+--
+
+-- | Llvm binary operators machine operations.
+data LlvmMachOp
+  = LM_MO_Add  -- ^ add two integer, floating point or vector values.
+  | LM_MO_Sub  -- ^ subtract two ...
+  | LM_MO_Mul  -- ^ multiply ..
+  | LM_MO_UDiv -- ^ unsigned integer or vector division.
+  | LM_MO_SDiv -- ^ signed integer ..
+  | LM_MO_URem -- ^ unsigned integer or vector remainder (mod)
+  | LM_MO_SRem -- ^ signed ...
+
+  | LM_MO_FAdd -- ^ add two floating point or vector values.
+  | LM_MO_FSub -- ^ subtract two ...
+  | LM_MO_FMul -- ^ multiply ...
+  | LM_MO_FDiv -- ^ divide ...
+  | LM_MO_FRem -- ^ remainder ...
+
+  -- | Left shift
+  | LM_MO_Shl
+  -- | Logical shift right
+  -- Shift right, filling with zero
+  | LM_MO_LShr
+  -- | Arithmetic shift right
+  -- The most significant bits of the result will be equal to the sign bit of
+  -- the left operand.
+  | LM_MO_AShr
+
+  | LM_MO_And -- ^ AND bitwise logical operation.
+  | LM_MO_Or  -- ^ OR bitwise logical operation.
+  | LM_MO_Xor -- ^ XOR bitwise logical operation.
+  deriving (Eq)
+
+instance Outputable LlvmMachOp where
+  ppr LM_MO_Add  = text "add"
+  ppr LM_MO_Sub  = text "sub"
+  ppr LM_MO_Mul  = text "mul"
+  ppr LM_MO_UDiv = text "udiv"
+  ppr LM_MO_SDiv = text "sdiv"
+  ppr LM_MO_URem = text "urem"
+  ppr LM_MO_SRem = text "srem"
+  ppr LM_MO_FAdd = text "fadd"
+  ppr LM_MO_FSub = text "fsub"
+  ppr LM_MO_FMul = text "fmul"
+  ppr LM_MO_FDiv = text "fdiv"
+  ppr LM_MO_FRem = text "frem"
+  ppr LM_MO_Shl  = text "shl"
+  ppr LM_MO_LShr = text "lshr"
+  ppr LM_MO_AShr = text "ashr"
+  ppr LM_MO_And  = text "and"
+  ppr LM_MO_Or   = text "or"
+  ppr LM_MO_Xor  = text "xor"
+
+
+-- | Llvm compare operations.
+data LlvmCmpOp
+  = LM_CMP_Eq  -- ^ Equal (Signed and Unsigned)
+  | LM_CMP_Ne  -- ^ Not equal (Signed and Unsigned)
+  | LM_CMP_Ugt -- ^ Unsigned greater than
+  | LM_CMP_Uge -- ^ Unsigned greater than or equal
+  | LM_CMP_Ult -- ^ Unsigned less than
+  | LM_CMP_Ule -- ^ Unsigned less than or equal
+  | LM_CMP_Sgt -- ^ Signed greater than
+  | LM_CMP_Sge -- ^ Signed greater than or equal
+  | LM_CMP_Slt -- ^ Signed less than
+  | LM_CMP_Sle -- ^ Signed less than or equal
+
+  -- Float comparisons. GHC uses a mix of ordered and unordered float
+  -- comparisons.
+  | LM_CMP_Feq -- ^ Float equal
+  | LM_CMP_Fne -- ^ Float not equal
+  | LM_CMP_Fgt -- ^ Float greater than
+  | LM_CMP_Fge -- ^ Float greater than or equal
+  | LM_CMP_Flt -- ^ Float less than
+  | LM_CMP_Fle -- ^ Float less than or equal
+  deriving (Eq)
+
+instance Outputable LlvmCmpOp where
+  ppr LM_CMP_Eq  = text "eq"
+  ppr LM_CMP_Ne  = text "ne"
+  ppr LM_CMP_Ugt = text "ugt"
+  ppr LM_CMP_Uge = text "uge"
+  ppr LM_CMP_Ult = text "ult"
+  ppr LM_CMP_Ule = text "ule"
+  ppr LM_CMP_Sgt = text "sgt"
+  ppr LM_CMP_Sge = text "sge"
+  ppr LM_CMP_Slt = text "slt"
+  ppr LM_CMP_Sle = text "sle"
+  ppr LM_CMP_Feq = text "oeq"
+  ppr LM_CMP_Fne = text "une"
+  ppr LM_CMP_Fgt = text "ogt"
+  ppr LM_CMP_Fge = text "oge"
+  ppr LM_CMP_Flt = text "olt"
+  ppr LM_CMP_Fle = text "ole"
+
+
+-- | Llvm cast operations.
+data LlvmCastOp
+  = LM_Trunc    -- ^ Integer truncate
+  | LM_Zext     -- ^ Integer extend (zero fill)
+  | LM_Sext     -- ^ Integer extend (sign fill)
+  | LM_Fptrunc  -- ^ Float truncate
+  | LM_Fpext    -- ^ Float extend
+  | LM_Fptoui   -- ^ Float to unsigned Integer
+  | LM_Fptosi   -- ^ Float to signed Integer
+  | LM_Uitofp   -- ^ Unsigned Integer to Float
+  | LM_Sitofp   -- ^ Signed Int to Float
+  | LM_Ptrtoint -- ^ Pointer to Integer
+  | LM_Inttoptr -- ^ Integer to Pointer
+  | LM_Bitcast  -- ^ Cast between types where no bit manipulation is needed
+  deriving (Eq)
+
+instance Outputable LlvmCastOp where
+  ppr LM_Trunc    = text "trunc"
+  ppr LM_Zext     = text "zext"
+  ppr LM_Sext     = text "sext"
+  ppr LM_Fptrunc  = text "fptrunc"
+  ppr LM_Fpext    = text "fpext"
+  ppr LM_Fptoui   = text "fptoui"
+  ppr LM_Fptosi   = text "fptosi"
+  ppr LM_Uitofp   = text "uitofp"
+  ppr LM_Sitofp   = text "sitofp"
+  ppr LM_Ptrtoint = text "ptrtoint"
+  ppr LM_Inttoptr = text "inttoptr"
+  ppr LM_Bitcast  = text "bitcast"
+
+
+-- -----------------------------------------------------------------------------
+-- * Floating point conversion
+--
+
+-- | Convert a Haskell Double to an LLVM hex encoded floating point form. In
+-- Llvm float literals can be printed in a big-endian hexadecimal format,
+-- regardless of underlying architecture.
+--
+-- See Note [LLVM Float Types].
+ppDouble :: Double -> SDoc
+ppDouble d
+  = let bs     = doubleToBytes d
+        hex d' = case showHex d' "" of
+                     []    -> error "dToStr: too few hex digits for float"
+                     [x]   -> ['0',x]
+                     [x,y] -> [x,y]
+                     _     -> error "dToStr: too many hex digits for float"
+
+    in sdocWithDynFlags (\dflags ->
+         let fixEndian = if wORDS_BIGENDIAN dflags then id else reverse
+             str       = map toUpper $ concat $ fixEndian $ map hex bs
+         in text "0x" <> text str)
+
+-- Note [LLVM Float Types]
+-- ~~~~~~~~~~~~~~~~~~~~~~~
+-- We use 'ppDouble' for both printing Float and Double floating point types. This is
+-- as LLVM expects all floating point constants (single & double) to be in IEEE
+-- 754 Double precision format. However, for single precision numbers (Float)
+-- they should be *representable* in IEEE 754 Single precision format. So the
+-- easiest way to do this is to narrow and widen again.
+-- (i.e., Double -> Float -> Double). We must be careful doing this that GHC
+-- doesn't optimize that away.
+
+-- Note [narrowFp & widenFp]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
+-- NOTE: we use float2Double & co directly as GHC likes to optimize away
+-- successive calls of 'realToFrac', defeating the narrowing. (Bug #7600).
+-- 'realToFrac' has inconsistent behaviour with optimisation as well that can
+-- also cause issues, these methods don't.
+
+narrowFp :: Double -> Float
+{-# NOINLINE narrowFp #-}
+narrowFp = double2Float
+
+widenFp :: Float -> Double
+{-# NOINLINE widenFp #-}
+widenFp = float2Double
+
+ppFloat :: Float -> SDoc
+ppFloat = ppDouble . widenFp
+
+
+--------------------------------------------------------------------------------
+-- * Misc functions
+--------------------------------------------------------------------------------
+
+ppCommaJoin :: (Outputable a) => [a] -> SDoc
+ppCommaJoin strs = hsep $ punctuate comma (map ppr strs)
+
+ppSpaceJoin :: (Outputable a) => [a] -> SDoc
+ppSpaceJoin strs = hsep (map ppr strs)