    {-# LANGUAGE CPP, GADTs, MultiWayIf #-}
    {-# 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 GHC.Prelude

    import GHC.Driver.Session
    import GHC.Driver.Ppr

    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 GHC.Data.FastString
    import GHC.Types.ForeignCall
    import GHC.Utils.Outputable
    import GHC.Utils.Panic (assertPanic)
    import qualified GHC.Utils.Panic as Panic
    import GHC.Platform
    import GHC.Data.OrdList
    import GHC.Types.Unique.Supply
    import GHC.Types.Unique
    import GHC.Utils.Misc

    import Control.Monad.Trans.Class
    import Control.Monad.Trans.Writer
    import Control.Monad

    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 (Signage -> Signage -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Signage -> Signage -> Bool
    $c/= :: Signage -> Signage -> Bool
    == :: Signage -> Signage -> Bool
    $c== :: Signage -> Signage -> Bool
    Eq, Int -> Signage -> ShowS
    [Signage] -> ShowS
    Signage -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Signage] -> ShowS
    $cshowList :: [Signage] -> ShowS
    show :: Signage -> String
    $cshow :: Signage -> String
    showsPrec :: Int -> Signage -> ShowS
    $cshowsPrec :: Int -> Signage -> ShowS
    Show)

    -- -----------------------------------------------------------------------------
    -- | Top-level of the LLVM proc Code generator
    --
    genLlvmProc :: RawCmmDecl -> LlvmM [LlvmCmmDecl]
    genLlvmProc :: RawCmmDecl -> LlvmM [LlvmCmmDecl]
    genLlvmProc (CmmProc LabelMap RawCmmStatics
    infos CLabel
    lbl [GlobalReg]
    live CmmGraph
    graph) = do
        let blocks :: [CmmBlock]
    blocks = CmmGraph -> [CmmBlock]
    toBlockListEntryFirstFalseFallthrough CmmGraph
    graph
        ([LlvmBasicBlock]
    lmblocks, [LlvmCmmDecl]
    lmdata) <- [GlobalReg]
    -> [CmmBlock] -> LlvmM ([LlvmBasicBlock], [LlvmCmmDecl])
    basicBlocksCodeGen [GlobalReg]
    live [CmmBlock]
    blocks
        let info :: Maybe RawCmmStatics
    info = forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup (forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    graph) LabelMap RawCmmStatics
    infos
            proc :: LlvmCmmDecl
    proc = forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc Maybe RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live (forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph [LlvmBasicBlock]
    lmblocks)
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmCmmDecl
    procforall a. a -> [a] -> [a]
    :[LlvmCmmDecl]
    lmdata)

    genLlvmProc RawCmmDecl
    _ = forall a. HasCallStack => String -> a
    panic String
    "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 :: [GlobalReg]
    -> [CmmBlock] -> LlvmM ([LlvmBasicBlock], [LlvmCmmDecl])
    basicBlocksCodeGen [GlobalReg]
    _    []                     = forall a. HasCallStack => String -> a
    panic String
    "no entry block!"
    basicBlocksCodeGen [GlobalReg]
    live [CmmBlock]
    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.
           BlockId
    bid <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
           (LlvmStatements
    prologue, [LlvmCmmDecl]
    prologueTops) <- [GlobalReg] -> [CmmBlock] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    funPrologue [GlobalReg]
    live [CmmBlock]
    cmmBlocks
           let entryBlock :: LlvmBasicBlock
    entryBlock = forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    bid (forall a. OrdList a -> [a]
    fromOL LlvmStatements
    prologue)

           -- Generate code
           ([LlvmBasicBlock]
    blocks, [[LlvmCmmDecl]]
    topss) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall a b. [(a, b)] -> ([a], [b])
    unzip forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM CmmBlock -> LlvmM (LlvmBasicBlock, [LlvmCmmDecl])
    basicBlockCodeGen [CmmBlock]
    cmmBlocks

           -- Compose
           forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmBasicBlock
    entryBlock forall a. a -> [a] -> [a]
    : [LlvmBasicBlock]
    blocks, [LlvmCmmDecl]
    prologueTops forall a. [a] -> [a] -> [a]
    ++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[LlvmCmmDecl]]
    topss)

    -- | Generate code for one block
    basicBlockCodeGen :: CmmBlock -> LlvmM ( LlvmBasicBlock, [LlvmCmmDecl] )
    basicBlockCodeGen :: CmmBlock -> LlvmM (LlvmBasicBlock, [LlvmCmmDecl])
    basicBlockCodeGen CmmBlock
    block
      = do let (CmmNode C O
    _, Block CmmNode O O
    nodes, CmmNode O C
    tail)  = forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    block
               id :: BlockId
    id = forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    block
           (LlvmStatements
    mid_instrs, [LlvmCmmDecl]
    top) <- forall (e :: Extensibility) (x :: Extensibility).
    [CmmNode e x] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    stmtsToInstrs forall a b. (a -> b) -> a -> b
    $ forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    nodes
           (LlvmStatements
    tail_instrs, [LlvmCmmDecl]
    top')  <- forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    stmtToInstrs CmmNode O C
    tail
           let instrs :: [LlvmStatement]
    instrs = forall a. OrdList a -> [a]
    fromOL (LlvmStatements
    mid_instrs forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    tail_instrs)
           forall (m :: * -> *) a. Monad m => a -> m a
    return (forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id [LlvmStatement]
    instrs, [LlvmCmmDecl]
    top' forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    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 :: forall (e :: Extensibility) (x :: Extensibility).
    [CmmNode e x] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    stmtsToInstrs [CmmNode e x]
    stmts
       = do ([LlvmStatements]
    instrss, [[LlvmCmmDecl]]
    topss) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall a b. [(a, b)] -> ([a], [b])
    unzip forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    stmtToInstrs [CmmNode e x]
    stmts
            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. [OrdList a] -> OrdList a
    concatOL [LlvmStatements]
    instrss, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[LlvmCmmDecl]]
    topss)

    -- | Convert a CmmStmt to a list of LlvmStatement's
    stmtToInstrs :: CmmNode e x -> LlvmM StmtData
    stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    stmtToInstrs CmmNode e x
    stmt = case CmmNode e x
    stmt of

        CmmComment LMString
    _         -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. OrdList a
    nilOL, []) -- nuke comments
        CmmTick    CmmTickish
    _         -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. OrdList a
    nilOL, [])
        CmmUnwind  {}        -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. OrdList a
    nilOL, [])

        CmmAssign CmmReg
    reg CmmExpr
    src    -> CmmReg -> CmmExpr -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genAssign CmmReg
    reg CmmExpr
    src
        CmmStore CmmExpr
    addr CmmExpr
    src AlignmentSpec
    align
                             -> CmmExpr
    -> CmmExpr
    -> AlignmentSpec
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore CmmExpr
    addr CmmExpr
    src AlignmentSpec
    align

        CmmBranch BlockId
    id         -> BlockId -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genBranch BlockId
    id
        CmmCondBranch CmmExpr
    arg BlockId
    true BlockId
    false Maybe Bool
    likely
                             -> CmmExpr
    -> BlockId
    -> BlockId
    -> Maybe Bool
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCondBranch CmmExpr
    arg BlockId
    true BlockId
    false Maybe Bool
    likely
        CmmSwitch CmmExpr
    arg SwitchTargets
    ids    -> CmmExpr -> SwitchTargets -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genSwitch CmmExpr
    arg SwitchTargets
    ids

        -- Foreign Call
        CmmUnsafeForeignCall ForeignTarget
    target [CmmFormal]
    res [CmmExpr]
    args
            -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCall ForeignTarget
    target [CmmFormal]
    res [CmmExpr]
    args

        -- Tail call
        CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    arg,
                  cml_args_regs :: CmmNode O C -> [GlobalReg]
    cml_args_regs = [GlobalReg]
    live } -> CmmExpr -> [GlobalReg] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genJump CmmExpr
    arg [GlobalReg]
    live

        CmmNode e x
    _ -> forall a. HasCallStack => String -> a
    panic String
    "Llvm.CodeGen.stmtToInstrs"

    -- | Wrapper function to declare an instrinct function by function type
    getInstrinct2 :: LMString -> LlvmType -> LlvmM ExprData
    getInstrinct2 :: LMString -> LlvmType -> LlvmM ExprData
    getInstrinct2 LMString
    fname fty :: LlvmType
    fty@(LMFunction LlvmFunctionDecl
    funSig) = do

        let fv :: LlvmVar
    fv   = LMString
    -> LlvmType
    -> LlvmLinkageType
    -> LMSection
    -> LMAlign
    -> LMConst
    -> LlvmVar
    LMGlobalVar LMString
    fname LlvmType
    fty (LlvmFunctionDecl -> LlvmLinkageType
    funcLinkage LlvmFunctionDecl
    funSig) forall a. Maybe a
    Nothing forall a. Maybe a
    Nothing LMConst
    Constant

        Maybe LlvmType
    fn <- forall key. Uniquable key => key -> LlvmM (Maybe LlvmType)
    funLookup LMString
    fname
        [LlvmCmmDecl]
    tops <- case Maybe LlvmType
    fn of
          Just LlvmType
    _  ->
            forall (m :: * -> *) a. Monad m => a -> m a
    return []
          Maybe LlvmType
    Nothing -> do
            forall key. Uniquable key => key -> LlvmType -> LlvmM ()
    funInsert LMString
    fname LlvmType
    fty
            Unique
    un <- forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
            let lbl :: CLabel
    lbl = forall a. Uniquable a => a -> CLabel
    mkAsmTempLabel Unique
    un
            forall (m :: * -> *) a. Monad m => a -> m a
    return [forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData (SectionType -> CLabel -> Section
    Section SectionType
    Data CLabel
    lbl) [([],[LlvmType
    fty])]]

        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    fv, forall a. OrdList a
    nilOL, [LlvmCmmDecl]
    tops)

    getInstrinct2 LMString
    _ LlvmType
    _ = forall a. HasCallStack => String -> a
    error String
    "getInstrinct2: Non-function type!"

    -- | Declares an instrinct function by return and parameter types
    getInstrinct :: LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData
    getInstrinct :: LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData
    getInstrinct LMString
    fname LlvmType
    retTy [LlvmType]
    parTys =
        let funSig :: LlvmFunctionDecl
    funSig = LMString
    -> LlvmLinkageType
    -> LlvmCallConvention
    -> LlvmType
    -> LlvmParameterListType
    -> [LlvmParameter]
    -> LMAlign
    -> LlvmFunctionDecl
    LlvmFunctionDecl LMString
    fname LlvmLinkageType
    ExternallyVisible LlvmCallConvention
    CC_Ccc LlvmType
    retTy
                        LlvmParameterListType
    FixedArgs ([LlvmType] -> [LlvmParameter]
    tysToParams [LlvmType]
    parTys) forall a. Maybe a
    Nothing
            fty :: LlvmType
    fty = LlvmFunctionDecl -> LlvmType
    LMFunction LlvmFunctionDecl
    funSig
        in LMString -> LlvmType -> LlvmM ExprData
    getInstrinct2 LMString
    fname LlvmType
    fty

    -- | Memory barrier instruction for LLVM >= 3.0
    barrier :: LlvmM StmtData
    barrier :: LlvmM (LlvmStatements, [LlvmCmmDecl])
    barrier = do
        let s :: LlvmStatement
    s = Bool -> LlvmSyncOrdering -> LlvmStatement
    Fence Bool
    False LlvmSyncOrdering
    SyncSeqCst
        forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> OrdList a
    unitOL LlvmStatement
    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 :: [Arch] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    barrierUnless [Arch]
    exs = do
        Platform
    platform <- LlvmM Platform
    getPlatform
        if Platform -> Arch
    platformArch Platform
    platform forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Arch]
    exs
            then forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. OrdList a
    nilOL, [])
            else LlvmM (LlvmStatements, [LlvmCmmDecl])
    barrier

    -- | Foreign Calls
    genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData

    -- Barriers need to be handled specially as they are implemented as LLVM
    -- intrinsic functions.
    genCall :: ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCall (PrimTarget CallishMachOp
    MO_ReadBarrier) [CmmFormal]
    _ [CmmExpr]
    _ =
        [Arch] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    barrierUnless [Arch
    ArchX86, Arch
    ArchX86_64, Arch
    ArchSPARC]

    genCall (PrimTarget CallishMachOp
    MO_WriteBarrier) [CmmFormal]
    _ [CmmExpr]
    _ =
        [Arch] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    barrierUnless [Arch
    ArchX86, Arch
    ArchX86_64, Arch
    ArchSPARC]

    genCall (PrimTarget CallishMachOp
    MO_Touch) [CmmFormal]
    _ [CmmExpr]
    _ =
        forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. OrdList a
    nilOL, [])

    genCall (PrimTarget (MO_UF_Conv Width
    w)) [CmmFormal
    dst] [CmmExpr
    e] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    dstV <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
        let ty :: LlvmType
    ty = CmmType -> LlvmType
    cmmToLlvmType forall a b. (a -> b) -> a -> b
    $ CmmFormal -> CmmType
    localRegType CmmFormal
    dst
            width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmFloat Width
    w
        LlvmVar
    castV <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ LlvmType -> LlvmM LlvmVar
    mkLocalVar LlvmType
    ty
        LlvmVar
    ve <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    e
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmExpression -> LlvmStatement
    Assignment LlvmVar
    castV forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Uitofp LlvmVar
    ve LlvmType
    width
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    castV LlvmVar
    dstV forall a. Maybe a
    Nothing

    genCall (PrimTarget (MO_UF_Conv Width
    _)) [CmmFormal
    _] [CmmExpr]
    args =
        forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genCall: Too many arguments to MO_UF_Conv. " forall a. [a] -> [a] -> [a]
    ++
        String
    "Can only handle 1, given" forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CmmExpr]
    args) forall a. [a] -> [a] -> [a]
    ++ String
    "."

    -- Handle prefetching data
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_Prefetch_Data Int
    localityInt)) [] [CmmExpr]
    args
      | Int
    0 forall a. Ord a => a -> a -> Bool
    <= Int
    localityInt Bool -> Bool -> Bool
    && Int
    localityInt forall a. Ord a => a -> a -> Bool
    <= Int
    3 = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        let argTy :: [LlvmType]
    argTy = [LlvmType
    i8Ptr, LlvmType
    i32, LlvmType
    i32, LlvmType
    i32]
            funTy :: LMString -> LlvmType
    funTy = \LMString
    name -> LlvmFunctionDecl -> LlvmType
    LMFunction forall a b. (a -> b) -> a -> b
    $ LMString
    -> LlvmLinkageType
    -> LlvmCallConvention
    -> LlvmType
    -> LlvmParameterListType
    -> [LlvmParameter]
    -> LMAlign
    -> LlvmFunctionDecl
    LlvmFunctionDecl LMString
    name LlvmLinkageType
    ExternallyVisible
                                 LlvmCallConvention
    CC_Ccc LlvmType
    LMVoid LlvmParameterListType
    FixedArgs ([LlvmType] -> [LlvmParameter]
    tysToParams [LlvmType]
    argTy) forall a. Maybe a
    Nothing

        let ([ForeignHint]
    _, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    t
        let args_hints' :: [(CmmExpr, ForeignHint)]
    args_hints' = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr]
    args [ForeignHint]
    arg_hints
        [LlvmVar]
    argVars <- [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> WriterT LlvmAccum LlvmM [LlvmVar]
    arg_varsW [(CmmExpr, ForeignHint)]
    args_hints' ([], forall a. OrdList a
    nilOL, [])
        LlvmVar
    fptr    <- LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
    liftExprData forall a b. (a -> b) -> a -> b
    $ (LMString -> LlvmType) -> ForeignTarget -> LlvmM ExprData
    getFunPtr LMString -> LlvmType
    funTy ForeignTarget
    t
        [LlvmVar]
    argVars' <- Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed forall a b. (a -> b) -> a -> b
    $ forall a b. [a] -> [b] -> [(a, b)]
    zip [LlvmVar]
    argVars [LlvmType]
    argTy

        let argSuffix :: [LlvmVar]
    argSuffix = [forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    i32 Integer
    0, forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    i32 Int
    localityInt, forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    i32 Integer
    1]
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmExpression -> LlvmStatement
    Expr forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    StdCall LlvmVar
    fptr ([LlvmVar]
    argVars' forall a. [a] -> [a] -> [a]
    ++ [LlvmVar]
    argSuffix) []
      | Bool
    otherwise = forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "prefetch locality level integer must be between 0 and 3, given: " forall a. [a] -> [a] -> [a]
    ++ (forall a. Show a => a -> String
    show Int
    localityInt)

    -- Handle PopCnt, Clz, Ctz, and BSwap that need to only convert arg
    -- and return types
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_PopCnt Width
    w)) [CmmFormal]
    dsts [CmmExpr]
    args =
        Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast Width
    w ForeignTarget
    t [CmmFormal]
    dsts [CmmExpr]
    args

    genCall t :: ForeignTarget
    t@(PrimTarget (MO_Pdep Width
    w)) [CmmFormal]
    dsts [CmmExpr]
    args =
        Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast2 Width
    w ForeignTarget
    t [CmmFormal]
    dsts [CmmExpr]
    args
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_Pext Width
    w)) [CmmFormal]
    dsts [CmmExpr]
    args =
        Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast2 Width
    w ForeignTarget
    t [CmmFormal]
    dsts [CmmExpr]
    args
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_Clz Width
    w)) [CmmFormal]
    dsts [CmmExpr]
    args =
        Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast Width
    w ForeignTarget
    t [CmmFormal]
    dsts [CmmExpr]
    args
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_Ctz Width
    w)) [CmmFormal]
    dsts [CmmExpr]
    args =
        Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast Width
    w ForeignTarget
    t [CmmFormal]
    dsts [CmmExpr]
    args
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_BSwap Width
    w)) [CmmFormal]
    dsts [CmmExpr]
    args =
        Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast Width
    w ForeignTarget
    t [CmmFormal]
    dsts [CmmExpr]
    args
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_BRev Width
    w)) [CmmFormal]
    dsts [CmmExpr]
    args =
        Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast Width
    w ForeignTarget
    t [CmmFormal]
    dsts [CmmExpr]
    args

    genCall (PrimTarget (MO_AtomicRMW Width
    width AtomicMachOp
    amop)) [CmmFormal
    dst] [CmmExpr
    addr, CmmExpr
    n] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    addrVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    addr
        LlvmVar
    nVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    n
        let targetTy :: LlvmType
    targetTy = Width -> LlvmType
    widthToLlvmInt Width
    width
            ptrExpr :: LlvmExpression
    ptrExpr = LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    addrVar (LlvmType -> LlvmType
    pLift LlvmType
    targetTy)
        LlvmVar
    ptrVar <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (LlvmType -> LlvmType
    pLift LlvmType
    targetTy) LlvmExpression
    ptrExpr
        LlvmVar
    dstVar <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
        let op :: LlvmAtomicOp
    op = case AtomicMachOp
    amop of
                   AtomicMachOp
    AMO_Add  -> LlvmAtomicOp
    LAO_Add
                   AtomicMachOp
    AMO_Sub  -> LlvmAtomicOp
    LAO_Sub
                   AtomicMachOp
    AMO_And  -> LlvmAtomicOp
    LAO_And
                   AtomicMachOp
    AMO_Nand -> LlvmAtomicOp
    LAO_Nand
                   AtomicMachOp
    AMO_Or   -> LlvmAtomicOp
    LAO_Or
                   AtomicMachOp
    AMO_Xor  -> LlvmAtomicOp
    LAO_Xor
        LlvmVar
    retVar <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    targetTy forall a b. (a -> b) -> a -> b
    $ LlvmAtomicOp
    -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> LlvmExpression
    AtomicRMW LlvmAtomicOp
    op LlvmVar
    ptrVar LlvmVar
    nVar LlvmSyncOrdering
    SyncSeqCst
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retVar LlvmVar
    dstVar forall a. Maybe a
    Nothing

    genCall (PrimTarget (MO_AtomicRead Width
    _)) [CmmFormal
    dst] [CmmExpr
    addr] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    dstV <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
        LlvmVar
    v1 <- Bool
    -> CmmExpr
    -> CmmType
    -> AlignmentSpec
    -> WriterT LlvmAccum LlvmM LlvmVar
    genLoadW Bool
    True CmmExpr
    addr (CmmFormal -> CmmType
    localRegType CmmFormal
    dst) AlignmentSpec
    NaturallyAligned
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    v1 LlvmVar
    dstV forall a. Maybe a
    Nothing

    genCall (PrimTarget (MO_Cmpxchg Width
    _width))
            [CmmFormal
    dst] [CmmExpr
    addr, CmmExpr
    old, CmmExpr
    new] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    addrVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    addr
        LlvmVar
    oldVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    old
        LlvmVar
    newVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    new
        let targetTy :: LlvmType
    targetTy = LlvmVar -> LlvmType
    getVarType LlvmVar
    oldVar
            ptrExpr :: LlvmExpression
    ptrExpr = LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    addrVar (LlvmType -> LlvmType
    pLift LlvmType
    targetTy)
        LlvmVar
    ptrVar <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (LlvmType -> LlvmType
    pLift LlvmType
    targetTy) LlvmExpression
    ptrExpr
        LlvmVar
    dstVar <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
        LlvmVar
    retVar <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW ([LlvmType] -> LlvmType
    LMStructU [LlvmType
    targetTy,LlvmType
    i1])
                  forall a b. (a -> b) -> a -> b
    $ LlvmVar
    -> LlvmVar
    -> LlvmVar
    -> LlvmSyncOrdering
    -> LlvmSyncOrdering
    -> LlvmExpression
    CmpXChg LlvmVar
    ptrVar LlvmVar
    oldVar LlvmVar
    newVar LlvmSyncOrdering
    SyncSeqCst LlvmSyncOrdering
    SyncSeqCst
        LlvmVar
    retVar' <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    targetTy forall a b. (a -> b) -> a -> b
    $ LlvmVar -> Int -> LlvmExpression
    ExtractV LlvmVar
    retVar Int
    0
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retVar' LlvmVar
    dstVar forall a. Maybe a
    Nothing

    genCall (PrimTarget (MO_Xchg Width
    _width)) [CmmFormal
    dst] [CmmExpr
    addr, CmmExpr
    val] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    dstV <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst) :: WriterT LlvmAccum LlvmM LlvmVar
        LlvmVar
    addrVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    addr
        LlvmVar
    valVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    val
        let ptrTy :: LlvmType
    ptrTy = LlvmType -> LlvmType
    pLift forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    valVar
            ptrExpr :: LlvmExpression
    ptrExpr = LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    addrVar LlvmType
    ptrTy
        LlvmVar
    ptrVar <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ptrTy LlvmExpression
    ptrExpr
        LlvmVar
    resVar <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (LlvmVar -> LlvmType
    getVarType LlvmVar
    valVar) (LlvmAtomicOp
    -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> LlvmExpression
    AtomicRMW LlvmAtomicOp
    LAO_Xchg LlvmVar
    ptrVar LlvmVar
    valVar LlvmSyncOrdering
    SyncSeqCst)
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    resVar LlvmVar
    dstV forall a. Maybe a
    Nothing

    genCall (PrimTarget (MO_AtomicWrite Width
    _width)) [] [CmmExpr
    addr, CmmExpr
    val] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    addrVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    addr
        LlvmVar
    valVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    val
        let ptrTy :: LlvmType
    ptrTy = LlvmType -> LlvmType
    pLift forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    valVar
            ptrExpr :: LlvmExpression
    ptrExpr = LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    addrVar LlvmType
    ptrTy
        LlvmVar
    ptrVar <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ptrTy LlvmExpression
    ptrExpr
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmExpression -> LlvmStatement
    Expr forall a b. (a -> b) -> a -> b
    $ LlvmAtomicOp
    -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> LlvmExpression
    AtomicRMW LlvmAtomicOp
    LAO_Xchg LlvmVar
    ptrVar LlvmVar
    valVar LlvmSyncOrdering
    SyncSeqCst

    -- Handle memcpy function specifically since llvm's intrinsic version takes
    -- some extra parameters.
    genCall t :: ForeignTarget
    t@(PrimTarget CallishMachOp
    op) [] [CmmExpr]
    args
     | Just Int
    align <- CallishMachOp -> LMAlign
    machOpMemcpyishAlign CallishMachOp
    op
     = do
       Platform
    platform <- LlvmM Platform
    getPlatform
       WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        let isVolTy :: [LlvmType]
    isVolTy = [LlvmType
    i1]
            isVolVal :: [LlvmVar]
    isVolVal = [forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    i1 Integer
    0]
            argTy :: [LlvmType]
    argTy | MO_Memset Int
    _ <- CallishMachOp
    op = [LlvmType
    i8Ptr, LlvmType
    i8,    Platform -> LlvmType
    llvmWord Platform
    platform, LlvmType
    i32] forall a. [a] -> [a] -> [a]
    ++ [LlvmType]
    isVolTy
                  | Bool
    otherwise         = [LlvmType
    i8Ptr, LlvmType
    i8Ptr, Platform -> LlvmType
    llvmWord Platform
    platform, LlvmType
    i32] forall a. [a] -> [a] -> [a]
    ++ [LlvmType]
    isVolTy
            funTy :: LMString -> LlvmType
    funTy = \LMString
    name -> LlvmFunctionDecl -> LlvmType
    LMFunction forall a b. (a -> b) -> a -> b
    $ LMString
    -> LlvmLinkageType
    -> LlvmCallConvention
    -> LlvmType
    -> LlvmParameterListType
    -> [LlvmParameter]
    -> LMAlign
    -> LlvmFunctionDecl
    LlvmFunctionDecl LMString
    name LlvmLinkageType
    ExternallyVisible
                                 LlvmCallConvention
    CC_Ccc LlvmType
    LMVoid LlvmParameterListType
    FixedArgs ([LlvmType] -> [LlvmParameter]
    tysToParams [LlvmType]
    argTy) forall a. Maybe a
    Nothing

        let ([ForeignHint]
    _, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    t
        let args_hints :: [(CmmExpr, ForeignHint)]
    args_hints = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr]
    args [ForeignHint]
    arg_hints
        [LlvmVar]
    argVars       <- [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> WriterT LlvmAccum LlvmM [LlvmVar]
    arg_varsW [(CmmExpr, ForeignHint)]
    args_hints ([], forall a. OrdList a
    nilOL, [])
        LlvmVar
    fptr          <- (LMString -> LlvmType)
    -> ForeignTarget -> WriterT LlvmAccum LlvmM LlvmVar
    getFunPtrW LMString -> LlvmType
    funTy ForeignTarget
    t
        [LlvmVar]
    argVars' <- Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed forall a b. (a -> b) -> a -> b
    $ forall a b. [a] -> [b] -> [(a, b)]
    zip [LlvmVar]
    argVars [LlvmType]
    argTy

        let alignVal :: LlvmVar
    alignVal = forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    i32 Int
    align
            arguments :: [LlvmVar]
    arguments = [LlvmVar]
    argVars' forall a. [a] -> [a] -> [a]
    ++ (LlvmVar
    alignValforall a. a -> [a] -> [a]
    :[LlvmVar]
    isVolVal)
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmExpression -> LlvmStatement
    Expr forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    StdCall LlvmVar
    fptr [LlvmVar]
    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 Width
    w)) [CmmFormal
    dstH, CmmFormal
    dstL] [CmmExpr
    lhs, CmmExpr
    rhs] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        let width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmInt Width
    w
            bitWidth :: Int
    bitWidth = Width -> Int
    widthInBits Width
    w
            width2x :: LlvmType
    width2x = Int -> LlvmType
    LMInt (Int
    bitWidth forall a. Num a => a -> a -> a
    * Int
    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.
        LlvmVar
    lhsVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    lhs
        LlvmVar
    rhsVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    rhs
        LlvmVar
    lhsExt <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Zext LlvmVar
    lhsVar LlvmType
    width2x
        LlvmVar
    rhsExt <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Zext LlvmVar
    rhsVar LlvmType
    width2x
        -- Do the actual multiplication (note that the result is also 2x width).
        LlvmVar
    retV <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Mul LlvmVar
    lhsExt LlvmVar
    rhsExt
        -- Extract the lower bits of the result into retL.
        LlvmVar
    retL <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    retV LlvmType
    width
        -- Now we unsigned right-shift the higher bits by width.
        let widthLlvmLit :: LlvmVar
    widthLlvmLit = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    bitWidth) LlvmType
    width
        LlvmVar
    retShifted <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_LShr LlvmVar
    retV LlvmVar
    widthLlvmLit
        -- And extract them into retH.
        LlvmVar
    retH <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    retShifted LlvmType
    width
        LlvmVar
    dstRegL <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstL)
        LlvmVar
    dstRegH <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstH)
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retL LlvmVar
    dstRegL forall a. Maybe a
    Nothing
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retH LlvmVar
    dstRegH forall a. Maybe a
    Nothing

    genCall (PrimTarget (MO_S_Mul2 Width
    w)) [CmmFormal
    dstC, CmmFormal
    dstH, CmmFormal
    dstL] [CmmExpr
    lhs, CmmExpr
    rhs] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        let width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmInt Width
    w
            bitWidth :: Int
    bitWidth = Width -> Int
    widthInBits Width
    w
            width2x :: LlvmType
    width2x = Int -> LlvmType
    LMInt (Int
    bitWidth forall a. Num a => a -> a -> a
    * Int
    2)
        -- First sign-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.
        LlvmVar
    lhsVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    lhs
        LlvmVar
    rhsVar <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    rhs
        LlvmVar
    lhsExt <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Sext LlvmVar
    lhsVar LlvmType
    width2x
        LlvmVar
    rhsExt <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Sext LlvmVar
    rhsVar LlvmType
    width2x
        -- Do the actual multiplication (note that the result is also 2x width).
        LlvmVar
    retV <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Mul LlvmVar
    lhsExt LlvmVar
    rhsExt
        -- Extract the lower bits of the result into retL.
        LlvmVar
    retL <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    retV LlvmType
    width
        -- Now we signed right-shift the higher bits by width.
        let widthLlvmLit :: LlvmVar
    widthLlvmLit = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    bitWidth) LlvmType
    width
        LlvmVar
    retShifted <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_AShr LlvmVar
    retV LlvmVar
    widthLlvmLit
        -- And extract them into retH.
        LlvmVar
    retH <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    retShifted LlvmType
    width
        -- Check if the carry is useful by doing a full arithmetic right shift on
        -- retL and comparing the result with retH
        let widthLlvmLitm1 :: LlvmVar
    widthLlvmLitm1 = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    bitWidth forall a. Num a => a -> a -> a
    - Integer
    1) LlvmType
    width
        LlvmVar
    retH' <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_AShr LlvmVar
    retL LlvmVar
    widthLlvmLitm1
        LlvmVar
    retC1  <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    i1 forall a b. (a -> b) -> a -> b
    $ LlvmCmpOp -> LlvmVar -> LlvmVar -> LlvmExpression
    Compare LlvmCmpOp
    LM_CMP_Ne LlvmVar
    retH LlvmVar
    retH' -- Compare op returns a 1-bit value (i1)
        LlvmVar
    retC   <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Zext LlvmVar
    retC1 LlvmType
    width  -- so we zero-extend it
        LlvmVar
    dstRegL <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstL)
        LlvmVar
    dstRegH <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstH)
        LlvmVar
    dstRegC <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstC)
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retL LlvmVar
    dstRegL forall a. Maybe a
    Nothing
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retH LlvmVar
    dstRegH forall a. Maybe a
    Nothing
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retC LlvmVar
    dstRegC forall a. Maybe a
    Nothing

    -- 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 Width
    w))
            [CmmFormal
    dstQ, CmmFormal
    dstR] [CmmExpr
    lhsH, CmmExpr
    lhsL, CmmExpr
    rhs] = WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do
        let width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmInt Width
    w
            bitWidth :: Int
    bitWidth = Width -> Int
    widthInBits Width
    w
            width2x :: LlvmType
    width2x = Int -> LlvmType
    LMInt (Int
    bitWidth forall a. Num a => a -> a -> a
    * Int
    2)
        -- First zero-extend all parameters to double width.
        let zeroExtend :: CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    zeroExtend CmmExpr
    expr = do
                LlvmVar
    var <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    expr
                LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Zext LlvmVar
    var LlvmType
    width2x
        LlvmVar
    lhsExtH <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    zeroExtend CmmExpr
    lhsH
        LlvmVar
    lhsExtL <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    zeroExtend CmmExpr
    lhsL
        LlvmVar
    rhsExt <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    zeroExtend CmmExpr
    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 :: LlvmVar
    widthLlvmLit = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    bitWidth) LlvmType
    width
        LlvmVar
    lhsExtHShifted <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Shl LlvmVar
    lhsExtH LlvmVar
    widthLlvmLit
        LlvmVar
    lhsExt <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Or LlvmVar
    lhsExtHShifted LlvmVar
    lhsExtL
        -- Finally, we can call 'udiv' and 'urem' to compute the results.
        LlvmVar
    retExtDiv <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_UDiv LlvmVar
    lhsExt LlvmVar
    rhsExt
        LlvmVar
    retExtRem <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width2x forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_URem LlvmVar
    lhsExt LlvmVar
    rhsExt
        -- And since everything is in 2x width, we need to truncate the results and
        -- then return them.
        let narrow :: LlvmVar -> WriterT LlvmAccum LlvmM LlvmVar
    narrow LlvmVar
    var = LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    var LlvmType
    width
        LlvmVar
    retDiv <- LlvmVar -> WriterT LlvmAccum LlvmM LlvmVar
    narrow LlvmVar
    retExtDiv
        LlvmVar
    retRem <- LlvmVar -> WriterT LlvmAccum LlvmM LlvmVar
    narrow LlvmVar
    retExtRem
        LlvmVar
    dstRegQ <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ CmmReg -> LlvmM LlvmVar
    getCmmReg (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstQ)
        LlvmVar
    dstRegR <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ CmmReg -> LlvmM LlvmVar
    getCmmReg (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstR)
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retDiv LlvmVar
    dstRegQ forall a. Maybe a
    Nothing
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retRem LlvmVar
    dstRegR forall a. Maybe a
    Nothing

    -- Handle the MO_{Add,Sub}IntC separately. LLVM versions return a record from
    -- which we need to extract the actual values.
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_AddIntC Width
    w)) [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs] =
        ForeignTarget
    -> Width
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallWithOverflow ForeignTarget
    t Width
    w [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs]
    genCall t :: ForeignTarget
    t@(PrimTarget (MO_SubIntC Width
    w)) [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs] =
        ForeignTarget
    -> Width
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallWithOverflow ForeignTarget
    t Width
    w [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    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 :: ForeignTarget
    t@(PrimTarget (MO_Add2 Width
    w)) [CmmFormal
    dstO, CmmFormal
    dstV] [CmmExpr
    lhs, CmmExpr
    rhs] =
        ForeignTarget
    -> Width
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallWithOverflow ForeignTarget
    t Width
    w [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs]

    genCall t :: ForeignTarget
    t@(PrimTarget (MO_AddWordC Width
    w)) [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs] =
        ForeignTarget
    -> Width
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallWithOverflow ForeignTarget
    t Width
    w [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs]

    genCall t :: ForeignTarget
    t@(PrimTarget (MO_SubWordC Width
    w)) [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs] =
        ForeignTarget
    -> Width
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallWithOverflow ForeignTarget
    t Width
    w [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs]

    -- Handle all other foreign calls and prim ops.
    genCall ForeignTarget
    target [CmmFormal]
    res [CmmExpr]
    args = do
      Platform
    platform <- LlvmM Platform
    getPlatform
      WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls forall a b. (a -> b) -> a -> b
    $ do

        -- extract Cmm call convention, and translate to LLVM call convention
        let lmconv :: LlvmCallConvention
    lmconv = case ForeignTarget
    target of
                ForeignTarget CmmExpr
    _ (ForeignConvention CCallConv
    conv [ForeignHint]
    _ [ForeignHint]
    _ CmmReturnInfo
    _) ->
                  case CCallConv
    conv of
                     CCallConv
    StdCallConv  -> case Platform -> Arch
    platformArch Platform
    platform of
                                     Arch
    ArchX86    -> LlvmCallConvention
    CC_X86_Stdcc
                                     Arch
    ArchX86_64 -> LlvmCallConvention
    CC_X86_Stdcc
                                     Arch
    _          -> LlvmCallConvention
    CC_Ccc
                     CCallConv
    CCallConv    -> LlvmCallConvention
    CC_Ccc
                     CCallConv
    CApiConv     -> LlvmCallConvention
    CC_Ccc
                     CCallConv
    PrimCallConv       -> forall a. HasCallStack => String -> a
    panic String
    "GHC.CmmToLlvm.CodeGen.genCall: PrimCallConv"
                     CCallConv
    JavaScriptCallConv -> forall a. HasCallStack => String -> a
    panic String
    "GHC.CmmToLlvm.CodeGen.genCall: JavaScriptCallConv"

                PrimTarget   CallishMachOp
    _ -> LlvmCallConvention
    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.
        -}

        -- parameter types
        let arg_type :: (CmmExpr, ForeignHint) -> LlvmParameter
    arg_type (CmmExpr
    _, ForeignHint
    AddrHint) = (LlvmType
    i8Ptr, [])
            -- cast pointers to i8*. Llvm equivalent of void*
            arg_type (CmmExpr
    expr, ForeignHint
    hint) =
                case CmmType -> LlvmType
    cmmToLlvmType forall a b. (a -> b) -> a -> b
    $ Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    expr of
                  ty :: LlvmType
    ty@(LMInt Int
    n) | Int
    n forall a. Ord a => a -> a -> Bool
    < Int
    64 Bool -> Bool -> Bool
    && LlvmCallConvention
    lmconv forall a. Eq a => a -> a -> Bool
    == LlvmCallConvention
    CC_Ccc Bool -> Bool -> Bool
    && Platform -> Bool
    platformCConvNeedsExtension Platform
    platform
                     -> (LlvmType
    ty, if ForeignHint
    hint forall a. Eq a => a -> a -> Bool
    == ForeignHint
    SignedHint then [LlvmParamAttr
    SignExt] else [LlvmParamAttr
    ZeroExt])
                  LlvmType
    ty -> (LlvmType
    ty, [])

        -- ret type
        let ret_type :: [(CmmFormal, ForeignHint)] -> LlvmType
    ret_type [] = LlvmType
    LMVoid
            ret_type [(CmmFormal
    _, ForeignHint
    AddrHint)] = LlvmType
    i8Ptr
            ret_type [(CmmFormal
    reg, ForeignHint
    _)]      = CmmType -> LlvmType
    cmmToLlvmType forall a b. (a -> b) -> a -> b
    $ CmmFormal -> CmmType
    localRegType CmmFormal
    reg
            ret_type [(CmmFormal, ForeignHint)]
    t = forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genCall: Too many return values! Can only handle"
                            forall a. [a] -> [a] -> [a]
    ++ String
    " 0 or 1, given " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(CmmFormal, ForeignHint)]
    t) forall a. [a] -> [a] -> [a]
    ++ String
    "."

        -- call attributes
        let fnAttrs :: [LlvmFuncAttr]
    fnAttrs | Bool
    never_returns = LlvmFuncAttr
    NoReturn forall a. a -> [a] -> [a]
    : [LlvmFuncAttr]
    llvmStdFunAttrs
                    | Bool
    otherwise     = [LlvmFuncAttr]
    llvmStdFunAttrs

            never_returns :: Bool
    never_returns = case ForeignTarget
    target of
                 ForeignTarget CmmExpr
    _ (ForeignConvention CCallConv
    _ [ForeignHint]
    _ [ForeignHint]
    _ CmmReturnInfo
    CmmNeverReturns) -> Bool
    True
                 ForeignTarget
    _ -> Bool
    False

        -- fun type
        let ([ForeignHint]
    res_hints, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    target
        let args_hints :: [(CmmExpr, ForeignHint)]
    args_hints = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr]
    args [ForeignHint]
    arg_hints
        let ress_hints :: [(CmmFormal, ForeignHint)]
    ress_hints = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmFormal]
    res  [ForeignHint]
    res_hints
        let ccTy :: LlvmCallType
    ccTy  = LlvmCallType
    StdCall -- tail calls should be done through CmmJump
        let retTy :: LlvmType
    retTy = [(CmmFormal, ForeignHint)] -> LlvmType
    ret_type [(CmmFormal, ForeignHint)]
    ress_hints
        let argTy :: [LlvmParameter]
    argTy = forall a b. (a -> b) -> [a] -> [b]
    map (CmmExpr, ForeignHint) -> LlvmParameter
    arg_type [(CmmExpr, ForeignHint)]
    args_hints
        let funTy :: LMString -> LlvmType
    funTy = \LMString
    name -> LlvmFunctionDecl -> LlvmType
    LMFunction forall a b. (a -> b) -> a -> b
    $ LMString
    -> LlvmLinkageType
    -> LlvmCallConvention
    -> LlvmType
    -> LlvmParameterListType
    -> [LlvmParameter]
    -> LMAlign
    -> LlvmFunctionDecl
    LlvmFunctionDecl LMString
    name LlvmLinkageType
    ExternallyVisible
                                 LlvmCallConvention
    lmconv LlvmType
    retTy LlvmParameterListType
    FixedArgs [LlvmParameter]
    argTy (Platform -> LMAlign
    llvmFunAlign Platform
    platform)

        [LlvmVar]
    argVars <- [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> WriterT LlvmAccum LlvmM [LlvmVar]
    arg_varsW [(CmmExpr, ForeignHint)]
    args_hints ([], forall a. OrdList a
    nilOL, [])
        LlvmVar
    fptr    <- (LMString -> LlvmType)
    -> ForeignTarget -> WriterT LlvmAccum LlvmM LlvmVar
    getFunPtrW LMString -> LlvmType
    funTy ForeignTarget
    target

        let doReturn :: WriterT LlvmAccum LlvmM ()
    doReturn | LlvmCallType
    ccTy forall a. Eq a => a -> a -> Bool
    == LlvmCallType
    TailCall  = LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ Maybe LlvmVar -> LlvmStatement
    Return forall a. Maybe a
    Nothing
                     | Bool
    never_returns     = LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmStatement
    Unreachable
                     | Bool
    otherwise         = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        -- make the actual call
        case LlvmType
    retTy of
            LlvmType
    LMVoid ->
                LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmExpression -> LlvmStatement
    Expr forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    ccTy LlvmVar
    fptr [LlvmVar]
    argVars [LlvmFuncAttr]
    fnAttrs
            LlvmType
    _ -> do
                LlvmVar
    v1 <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    retTy forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    ccTy LlvmVar
    fptr [LlvmVar]
    argVars [LlvmFuncAttr]
    fnAttrs
                -- get the return register
                let ret_reg :: [a] -> a
    ret_reg [a
    reg] = a
    reg
                    ret_reg [a]
    t = forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genCall: Bad number of registers! Can only handle"
                                    forall a. [a] -> [a] -> [a]
    ++ String
    " 1, given " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    t) forall a. [a] -> [a] -> [a]
    ++ String
    "."
                let creg :: CmmFormal
    creg = forall {a}. [a] -> a
    ret_reg [CmmFormal]
    res
                LlvmVar
    vreg <- CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    creg)
                if LlvmType
    retTy forall a. Eq a => a -> a -> Bool
    == LlvmType -> LlvmType
    pLower (LlvmVar -> LlvmType
    getVarType LlvmVar
    vreg)
                    then do
                        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    v1 LlvmVar
    vreg forall a. Maybe a
    Nothing
                        WriterT LlvmAccum LlvmM ()
    doReturn
                    else do
                        let ty :: LlvmType
    ty = LlvmType -> LlvmType
    pLower forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    vreg
                        let op :: LlvmCastOp
    op = case LlvmType
    ty of
                                LlvmType
    vt | LlvmType -> Bool
    isPointer LlvmType
    vt -> LlvmCastOp
    LM_Bitcast
                                   | LlvmType -> Bool
    isInt     LlvmType
    vt -> LlvmCastOp
    LM_Ptrtoint
                                   | Bool
    otherwise    ->
                                       forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genCall: CmmReg bad match for"
                                            forall a. [a] -> [a] -> [a]
    ++ String
    " returned type!"

                        LlvmVar
    v2 <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    op LlvmVar
    v1 LlvmType
    ty
                        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    v2 LlvmVar
    vreg forall a. Maybe a
    Nothing
                        WriterT LlvmAccum LlvmM ()
    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 :: ForeignTarget
    -> Width
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallWithOverflow t :: ForeignTarget
    t@(PrimTarget CallishMachOp
    op) Width
    w [CmmFormal
    dstV, CmmFormal
    dstO] [CmmExpr
    lhs, CmmExpr
    rhs] = do
        -- So far this was only tested for the following four CallishMachOps.
        let valid :: Bool
    valid = CallishMachOp
    op forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`   [ Width -> CallishMachOp
    MO_Add2 Width
    w
                                , Width -> CallishMachOp
    MO_AddIntC Width
    w
                                , Width -> CallishMachOp
    MO_SubIntC Width
    w
                                , Width -> CallishMachOp
    MO_AddWordC Width
    w
                                , Width -> CallishMachOp
    MO_SubWordC Width
    w
                                ]
        MASSERT(valid)
        let width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmInt Width
    w
        -- This will do most of the work of generating the call to the intrinsic and
        -- extracting the values from the struct.
        (LlvmVar
    value, LlvmVar
    overflowBit, (LlvmStatements
    stmts, [LlvmCmmDecl]
    top)) <-
          ForeignTarget
    -> Width
    -> (CmmExpr, CmmExpr)
    -> (LlvmType, LlvmType)
    -> LlvmM (LlvmVar, LlvmVar, (LlvmStatements, [LlvmCmmDecl]))
    genCallExtract ForeignTarget
    t Width
    w (CmmExpr
    lhs, CmmExpr
    rhs) (LlvmType
    width, LlvmType
    i1)
        -- value is i<width>, but overflowBit is i1, so we need to cast (Cmm expects
        -- both to be i<width>)
        (LlvmVar
    overflow, LlvmStatement
    zext) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Zext LlvmVar
    overflowBit LlvmType
    width
        LlvmVar
    dstRegV <- CmmReg -> LlvmM LlvmVar
    getCmmReg (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstV)
        LlvmVar
    dstRegO <- CmmReg -> LlvmM LlvmVar
    getCmmReg (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dstO)
        let storeV :: LlvmStatement
    storeV = LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    value LlvmVar
    dstRegV forall a. Maybe a
    Nothing
            storeO :: LlvmStatement
    storeO = LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    overflow LlvmVar
    dstRegO forall a. Maybe a
    Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    zext forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    storeV forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    storeO, [LlvmCmmDecl]
    top)
    genCallWithOverflow ForeignTarget
    _ Width
    _ [CmmFormal]
    _ [CmmExpr]
    _ =
        forall a. HasCallStack => String -> a
    panic String
    "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 :: ForeignTarget
    -> Width
    -> (CmmExpr, CmmExpr)
    -> (LlvmType, LlvmType)
    -> LlvmM (LlvmVar, LlvmVar, (LlvmStatements, [LlvmCmmDecl]))
    genCallExtract target :: ForeignTarget
    target@(PrimTarget CallishMachOp
    op) Width
    w (CmmExpr
    argA, CmmExpr
    argB) (LlvmType
    llvmTypeA, LlvmType
    llvmTypeB) = do
        let width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmInt Width
    w
            argTy :: [LlvmType]
    argTy = [LlvmType
    width, LlvmType
    width]
            retTy :: LlvmType
    retTy = [LlvmType] -> LlvmType
    LMStructU [LlvmType
    llvmTypeA, LlvmType
    llvmTypeB]

        -- Process the arguments.
        let args_hints :: [(CmmExpr, ForeignHint)]
    args_hints = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr
    argA, CmmExpr
    argB] (forall a b. (a, b) -> b
    snd forall a b. (a -> b) -> a -> b
    $ ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    target)
        ([LlvmVar]
    argsV1, LlvmStatements
    args1, [LlvmCmmDecl]
    top1) <- [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    arg_vars [(CmmExpr, ForeignHint)]
    args_hints ([], forall a. OrdList a
    nilOL, [])
        ([LlvmVar]
    argsV2, LlvmStatements
    args2) <- Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars Signage
    Signed forall a b. (a -> b) -> a -> b
    $ forall a b. [a] -> [b] -> [(a, b)]
    zip [LlvmVar]
    argsV1 [LlvmType]
    argTy

        -- Get the function and make the call.
        LMString
    fname <- CallishMachOp -> LlvmM LMString
    cmmPrimOpFunctions CallishMachOp
    op
        (LlvmVar
    fptr, LlvmStatements
    _, [LlvmCmmDecl]
    top2) <- LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData
    getInstrinct LMString
    fname LlvmType
    retTy [LlvmType]
    argTy
        -- We use StdCall for primops. See also the last case of genCall.
        (LlvmVar
    retV, LlvmStatement
    call) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    retTy forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    StdCall LlvmVar
    fptr [LlvmVar]
    argsV2 []

        -- This will result in a two element struct, we need to use "extractvalue"
        -- to get them out of it.
        (LlvmVar
    res1, LlvmStatement
    ext1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    llvmTypeA (LlvmVar -> Int -> LlvmExpression
    ExtractV LlvmVar
    retV Int
    0)
        (LlvmVar
    res2, LlvmStatement
    ext2) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    llvmTypeB (LlvmVar -> Int -> LlvmExpression
    ExtractV LlvmVar
    retV Int
    1)

        let stmts :: LlvmStatements
    stmts = LlvmStatements
    args1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    args2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    call forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    ext1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    ext2
            tops :: [LlvmCmmDecl]
    tops = [LlvmCmmDecl]
    top1 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top2
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    res1, LlvmVar
    res2, (LlvmStatements
    stmts, [LlvmCmmDecl]
    tops))

    genCallExtract ForeignTarget
    _ Width
    _ (CmmExpr, CmmExpr)
    _ (LlvmType, LlvmType)
    _ =
        forall a. HasCallStack => String -> a
    panic String
    "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 :: Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast Width
    w t :: ForeignTarget
    t@(PrimTarget CallishMachOp
    op) [CmmFormal
    dst] [CmmExpr]
    args = do
        let width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmInt Width
    w
            dstTy :: LlvmType
    dstTy = CmmType -> LlvmType
    cmmToLlvmType forall a b. (a -> b) -> a -> b
    $ CmmFormal -> CmmType
    localRegType CmmFormal
    dst

        LMString
    fname                       <- CallishMachOp -> LlvmM LMString
    cmmPrimOpFunctions CallishMachOp
    op
        (LlvmVar
    fptr, LlvmStatements
    _, [LlvmCmmDecl]
    top3)             <- LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData
    getInstrinct LMString
    fname LlvmType
    width [LlvmType
    width]

        LlvmVar
    dstV                        <- CmmReg -> LlvmM LlvmVar
    getCmmReg (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)

        let ([ForeignHint]
    _, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    t
        let args_hints :: [(CmmExpr, ForeignHint)]
    args_hints = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr]
    args [ForeignHint]
    arg_hints
        ([LlvmVar]
    argsV, LlvmStatements
    stmts2, [LlvmCmmDecl]
    top2)       <- [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    arg_vars [(CmmExpr, ForeignHint)]
    args_hints ([], forall a. OrdList a
    nilOL, [])
        ([LlvmVar]
    argsV', LlvmStatements
    stmts4)            <- Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars Signage
    Signed forall a b. (a -> b) -> a -> b
    $ forall a b. [a] -> [b] -> [(a, b)]
    zip [LlvmVar]
    argsV [LlvmType
    width]
        (LlvmVar
    retV, LlvmStatement
    s1)                  <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    StdCall LlvmVar
    fptr [LlvmVar]
    argsV' []
        ([LlvmVar]
    retVs', LlvmStatements
    stmts5)            <- Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars (CallishMachOp -> Signage
    cmmPrimOpRetValSignage CallishMachOp
    op) [(LlvmVar
    retV,LlvmType
    dstTy)]
        let retV' :: LlvmVar
    retV'                    = forall a. String -> [a] -> a
    singletonPanic String
    "genCallSimpleCast" [LlvmVar]
    retVs'
        let s2 :: LlvmStatement
    s2                       = LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retV' LlvmVar
    dstV forall a. Maybe a
    Nothing

        let stmts :: LlvmStatements
    stmts = LlvmStatements
    stmts2 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts4 forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    LlvmStatement
    s1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts5 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts, [LlvmCmmDecl]
    top2 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top3)
    genCallSimpleCast Width
    _ ForeignTarget
    _ [CmmFormal]
    dsts [CmmExpr]
    _ =
        forall a. HasCallStack => String -> a
    panic (String
    "genCallSimpleCast: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CmmFormal]
    dsts) forall a. [a] -> [a] -> [a]
    ++ String
    " 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 :: Width
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCallSimpleCast2 Width
    w t :: ForeignTarget
    t@(PrimTarget CallishMachOp
    op) [CmmFormal
    dst] [CmmExpr]
    args = do
        let width :: LlvmType
    width = Width -> LlvmType
    widthToLlvmInt Width
    w
            dstTy :: LlvmType
    dstTy = CmmType -> LlvmType
    cmmToLlvmType forall a b. (a -> b) -> a -> b
    $ CmmFormal -> CmmType
    localRegType CmmFormal
    dst

        LMString
    fname                       <- CallishMachOp -> LlvmM LMString
    cmmPrimOpFunctions CallishMachOp
    op
        (LlvmVar
    fptr, LlvmStatements
    _, [LlvmCmmDecl]
    top3)             <- LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData
    getInstrinct LMString
    fname LlvmType
    width (forall a b. a -> b -> a
    const LlvmType
    width forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [CmmExpr]
    args)

        LlvmVar
    dstV                        <- CmmReg -> LlvmM LlvmVar
    getCmmReg (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)

        let ([ForeignHint]
    _, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    t
        let args_hints :: [(CmmExpr, ForeignHint)]
    args_hints = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr]
    args [ForeignHint]
    arg_hints
        ([LlvmVar]
    argsV, LlvmStatements
    stmts2, [LlvmCmmDecl]
    top2)       <- [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    arg_vars [(CmmExpr, ForeignHint)]
    args_hints ([], forall a. OrdList a
    nilOL, [])
        ([LlvmVar]
    argsV', LlvmStatements
    stmts4)            <- Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars Signage
    Signed forall a b. (a -> b) -> a -> b
    $ forall a b. [a] -> [b] -> [(a, b)]
    zip [LlvmVar]
    argsV (forall a b. a -> b -> a
    const LlvmType
    width forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LlvmVar]
    argsV)
        (LlvmVar
    retV, LlvmStatement
    s1)                  <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    width forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    StdCall LlvmVar
    fptr [LlvmVar]
    argsV' []
        ([LlvmVar]
    retVs', LlvmStatements
    stmts5)             <- Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars (CallishMachOp -> Signage
    cmmPrimOpRetValSignage CallishMachOp
    op) [(LlvmVar
    retV,LlvmType
    dstTy)]
        let retV' :: LlvmVar
    retV'                    = forall a. String -> [a] -> a
    singletonPanic String
    "genCallSimpleCast2" [LlvmVar]
    retVs'
        let s2 :: LlvmStatement
    s2                       = LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    retV' LlvmVar
    dstV forall a. Maybe a
    Nothing

        let stmts :: LlvmStatements
    stmts = LlvmStatements
    stmts2 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts4 forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    LlvmStatement
    s1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts5 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts, [LlvmCmmDecl]
    top2 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top3)
    genCallSimpleCast2 Width
    _ ForeignTarget
    _ [CmmFormal]
    dsts [CmmExpr]
    _ =
        forall a. HasCallStack => String -> a
    panic (String
    "genCallSimpleCast2: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CmmFormal]
    dsts) forall a. [a] -> [a] -> [a]
    ++ String
    " dsts")

    -- | Create a function pointer from a target.
    getFunPtrW :: (LMString -> LlvmType) -> ForeignTarget
               -> WriterT LlvmAccum LlvmM LlvmVar
    getFunPtrW :: (LMString -> LlvmType)
    -> ForeignTarget -> WriterT LlvmAccum LlvmM LlvmVar
    getFunPtrW LMString -> LlvmType
    funTy ForeignTarget
    targ = LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
    liftExprData forall a b. (a -> b) -> a -> b
    $ (LMString -> LlvmType) -> ForeignTarget -> LlvmM ExprData
    getFunPtr LMString -> LlvmType
    funTy ForeignTarget
    targ

    -- | Create a function pointer from a target.
    getFunPtr :: (LMString -> LlvmType) -> ForeignTarget
              -> LlvmM ExprData
    getFunPtr :: (LMString -> LlvmType) -> ForeignTarget -> LlvmM ExprData
    getFunPtr LMString -> LlvmType
    funTy ForeignTarget
    targ = case ForeignTarget
    targ of
        ForeignTarget (CmmLit (CmmLabel CLabel
    lbl)) ForeignConvention
    _ -> do
            LMString
    name <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    lbl
            LMString -> LlvmType -> LlvmM ExprData
    getHsFunc' LMString
    name (LMString -> LlvmType
    funTy LMString
    name)

        ForeignTarget CmmExpr
    expr ForeignConvention
    _ -> do
            (LlvmVar
    v1, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    expr
            DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            let fty :: LlvmType
    fty = LMString -> LlvmType
    funTy forall a b. (a -> b) -> a -> b
    $ String -> LMString
    fsLit String
    "dynamic"
                cast :: LlvmCastOp
    cast = case LlvmVar -> LlvmType
    getVarType LlvmVar
    v1 of
                    LlvmType
    ty | LlvmType -> Bool
    isPointer LlvmType
    ty -> LlvmCastOp
    LM_Bitcast
                    LlvmType
    ty | LlvmType -> Bool
    isInt LlvmType
    ty     -> LlvmCastOp
    LM_Inttoptr

                    LlvmType
    ty -> forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genCall: Expr is of bad type for function"
                                  forall a. [a] -> [a] -> [a]
    ++ String
    " call! (" forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr LlvmType
    ty) forall a. [a] -> [a] -> [a]
    ++ String
    ")"

            (LlvmVar
    v2,LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (LlvmType -> LlvmType
    pLift LlvmType
    fty) forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    cast LlvmVar
    v1 (LlvmType -> LlvmType
    pLift LlvmType
    fty)
            forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v2, LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top)

        PrimTarget CallishMachOp
    mop -> do
            LMString
    name <- CallishMachOp -> LlvmM LMString
    cmmPrimOpFunctions CallishMachOp
    mop
            let fty :: LlvmType
    fty = LMString -> LlvmType
    funTy LMString
    name
            LMString -> LlvmType -> LlvmM ExprData
    getInstrinct2 LMString
    name LlvmType
    fty

    -- | Conversion of call arguments.
    arg_varsW :: [(CmmActual, ForeignHint)]
              -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
              -> WriterT LlvmAccum LlvmM [LlvmVar]
    arg_varsW :: [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> WriterT LlvmAccum LlvmM [LlvmVar]
    arg_varsW [(CmmExpr, ForeignHint)]
    xs ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    ys = do
        ([LlvmVar]
    vars, LlvmStatements
    stmts, [LlvmCmmDecl]
    decls) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    arg_vars [(CmmExpr, ForeignHint)]
    xs ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    ys
        forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    tell forall a b. (a -> b) -> a -> b
    $ LlvmStatements -> [LlvmCmmDecl] -> LlvmAccum
    LlvmAccum LlvmStatements
    stmts [LlvmCmmDecl]
    decls
        forall (m :: * -> *) a. Monad m => a -> m a
    return [LlvmVar]
    vars

    -- | Conversion of call arguments.
    arg_vars :: [(CmmActual, ForeignHint)]
             -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
             -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])

    arg_vars :: [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    arg_vars [] ([LlvmVar]
    vars, LlvmStatements
    stmts, [LlvmCmmDecl]
    tops)
      = forall (m :: * -> *) a. Monad m => a -> m a
    return ([LlvmVar]
    vars, LlvmStatements
    stmts, [LlvmCmmDecl]
    tops)

    arg_vars ((CmmExpr
    e, ForeignHint
    AddrHint):[(CmmExpr, ForeignHint)]
    rest) ([LlvmVar]
    vars, LlvmStatements
    stmts, [LlvmCmmDecl]
    tops)
      = do (LlvmVar
    v1, LlvmStatements
    stmts', [LlvmCmmDecl]
    top') <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    e
           DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           let op :: LlvmCastOp
    op = case LlvmVar -> LlvmType
    getVarType LlvmVar
    v1 of
                   LlvmType
    ty | LlvmType -> Bool
    isPointer LlvmType
    ty -> LlvmCastOp
    LM_Bitcast
                   LlvmType
    ty | LlvmType -> Bool
    isInt LlvmType
    ty     -> LlvmCastOp
    LM_Inttoptr

                   LlvmType
    a  -> forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genCall: Can't cast llvmType to i8*! ("
                               forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr LlvmType
    a) forall a. [a] -> [a] -> [a]
    ++ String
    ")"

           (LlvmVar
    v2, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    i8Ptr forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    op LlvmVar
    v1 LlvmType
    i8Ptr
           [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    arg_vars [(CmmExpr, ForeignHint)]
    rest ([LlvmVar]
    vars forall a. [a] -> [a] -> [a]
    ++ [LlvmVar
    v2], LlvmStatements
    stmts forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts' forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1,
                                   [LlvmCmmDecl]
    tops forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top')

    arg_vars ((CmmExpr
    e, ForeignHint
    _):[(CmmExpr, ForeignHint)]
    rest) ([LlvmVar]
    vars, LlvmStatements
    stmts, [LlvmCmmDecl]
    tops)
      = do (LlvmVar
    v1, LlvmStatements
    stmts', [LlvmCmmDecl]
    top') <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    e
           [(CmmExpr, ForeignHint)]
    -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])
    arg_vars [(CmmExpr, ForeignHint)]
    rest ([LlvmVar]
    vars forall a. [a] -> [a] -> [a]
    ++ [LlvmVar
    v1], LlvmStatements
    stmts forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts', [LlvmCmmDecl]
    tops forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top')

    -- | Cast a collection of LLVM variables to specific types.
    castVarsW :: Signage
              -> [(LlvmVar, LlvmType)]
              -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW :: Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    signage [(LlvmVar, LlvmType)]
    vars = do
        ([LlvmVar]
    vars, LlvmStatements
    stmts) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars Signage
    signage [(LlvmVar, LlvmType)]
    vars
        forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    tell forall a b. (a -> b) -> a -> b
    $ LlvmStatements -> [LlvmCmmDecl] -> LlvmAccum
    LlvmAccum LlvmStatements
    stmts forall a. Monoid a => a
    mempty
        forall (m :: * -> *) a. Monad m => a -> m a
    return [LlvmVar]
    vars

    -- | Cast a collection of LLVM variables to specific types.
    castVars :: Signage -> [(LlvmVar, LlvmType)]
             -> LlvmM ([LlvmVar], LlvmStatements)
    castVars :: Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars Signage
    signage [(LlvmVar, LlvmType)]
    vars = do
                    [(LlvmVar, LlvmStatement)]
    done <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Signage -> LlvmVar -> LlvmType -> LlvmM (LlvmVar, LlvmStatement)
    castVar Signage
    signage)) [(LlvmVar, LlvmType)]
    vars
                    let ([LlvmVar]
    vars', [LlvmStatement]
    stmts) = forall a b. [(a, b)] -> ([a], [b])
    unzip [(LlvmVar, LlvmStatement)]
    done
                    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LlvmVar]
    vars', forall a. [a] -> OrdList a
    toOL [LlvmStatement]
    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 -> LlvmVar -> LlvmType -> LlvmM (LlvmVar, LlvmStatement)
    castVar Signage
    signage LlvmVar
    v LlvmType
    t | LlvmVar -> LlvmType
    getVarType LlvmVar
    v forall a. Eq a => a -> a -> Bool
    == LlvmType
    t
                = forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v, LlvmStatement
    Nop)

                | Bool
    otherwise
                = do DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                     Platform
    platform <- LlvmM Platform
    getPlatform
                     let op :: LlvmCastOp
    op = case (LlvmVar -> LlvmType
    getVarType LlvmVar
    v, LlvmType
    t) of
                          (LMInt Int
    n, LMInt Int
    m)
                              -> if Int
    n forall a. Ord a => a -> a -> Bool
    < Int
    m then LlvmCastOp
    extend else LlvmCastOp
    LM_Trunc
                          (LlvmType
    vt, LlvmType
    _) | LlvmType -> Bool
    isFloat LlvmType
    vt Bool -> Bool -> Bool
    && LlvmType -> Bool
    isFloat LlvmType
    t
                              -> if Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    vt forall a. Ord a => a -> a -> Bool
    < Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    t
                                    then LlvmCastOp
    LM_Fpext else LlvmCastOp
    LM_Fptrunc
                          (LlvmType
    vt, LlvmType
    _) | LlvmType -> Bool
    isInt LlvmType
    vt Bool -> Bool -> Bool
    && LlvmType -> Bool
    isFloat LlvmType
    t       -> LlvmCastOp
    LM_Sitofp
                          (LlvmType
    vt, LlvmType
    _) | LlvmType -> Bool
    isFloat LlvmType
    vt Bool -> Bool -> Bool
    && LlvmType -> Bool
    isInt LlvmType
    t       -> LlvmCastOp
    LM_Fptosi
                          (LlvmType
    vt, LlvmType
    _) | LlvmType -> Bool
    isInt LlvmType
    vt Bool -> Bool -> Bool
    && LlvmType -> Bool
    isPointer LlvmType
    t     -> LlvmCastOp
    LM_Inttoptr
                          (LlvmType
    vt, LlvmType
    _) | LlvmType -> Bool
    isPointer LlvmType
    vt Bool -> Bool -> Bool
    && LlvmType -> Bool
    isInt LlvmType
    t     -> LlvmCastOp
    LM_Ptrtoint
                          (LlvmType
    vt, LlvmType
    _) | LlvmType -> Bool
    isPointer LlvmType
    vt Bool -> Bool -> Bool
    && LlvmType -> Bool
    isPointer LlvmType
    t -> LlvmCastOp
    LM_Bitcast
                          (LlvmType
    vt, LlvmType
    _) | LlvmType -> Bool
    isVector LlvmType
    vt Bool -> Bool -> Bool
    && LlvmType -> Bool
    isVector LlvmType
    t   -> LlvmCastOp
    LM_Bitcast

                          (LlvmType
    vt, LlvmType
    _) -> forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "castVars: Can't cast this type ("
                                      forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr LlvmType
    vt) forall a. [a] -> [a] -> [a]
    ++ String
    ") to (" forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr LlvmType
    t) forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                     LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    t forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    op LlvmVar
    v LlvmType
    t
        where extend :: LlvmCastOp
    extend = case Signage
    signage of
                Signage
    Signed      -> LlvmCastOp
    LM_Sext
                Signage
    Unsigned    -> LlvmCastOp
    LM_Zext

    cmmPrimOpRetValSignage :: CallishMachOp -> Signage
    cmmPrimOpRetValSignage :: CallishMachOp -> Signage
    cmmPrimOpRetValSignage CallishMachOp
    mop = case CallishMachOp
    mop of
        MO_Pdep Width
    _   -> Signage
    Unsigned
        MO_Pext Width
    _   -> Signage
    Unsigned
        CallishMachOp
    _           -> Signage
    Signed

    -- | Decide what C function to use to implement a CallishMachOp
    cmmPrimOpFunctions :: CallishMachOp -> LlvmM LMString
    cmmPrimOpFunctions :: CallishMachOp -> LlvmM LMString
    cmmPrimOpFunctions CallishMachOp
    mop = do

      DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      Platform
    platform <- LlvmM Platform
    getPlatform
      let intrinTy1 :: String
    intrinTy1 = String
    "p0i8.p0i8." forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Platform -> LlvmType
    llvmWord Platform
    platform)
          intrinTy2 :: String
    intrinTy2 = String
    "p0i8." forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Platform -> LlvmType
    llvmWord Platform
    platform)
          unsupported :: LMString
    unsupported = forall a. HasCallStack => String -> a
    panic (String
    "cmmPrimOpFunctions: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show CallishMachOp
    mop
                            forall a. [a] -> [a] -> [a]
    ++ String
    " not supported here")
          dontReach64 :: LMString
    dontReach64 = forall a. HasCallStack => String -> a
    panic (String
    "cmmPrimOpFunctions: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show CallishMachOp
    mop
                            forall a. [a] -> [a] -> [a]
    ++ String
    " should be not be encountered because the regular primop for this 64-bit operation is used instead.")

      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ case CallishMachOp
    mop of
        CallishMachOp
    MO_F32_Exp    -> String -> LMString
    fsLit String
    "expf"
        CallishMachOp
    MO_F32_ExpM1  -> String -> LMString
    fsLit String
    "expm1f"
        CallishMachOp
    MO_F32_Log    -> String -> LMString
    fsLit String
    "logf"
        CallishMachOp
    MO_F32_Log1P  -> String -> LMString
    fsLit String
    "log1pf"
        CallishMachOp
    MO_F32_Sqrt   -> String -> LMString
    fsLit String
    "llvm.sqrt.f32"
        CallishMachOp
    MO_F32_Fabs   -> String -> LMString
    fsLit String
    "llvm.fabs.f32"
        CallishMachOp
    MO_F32_Pwr    -> String -> LMString
    fsLit String
    "llvm.pow.f32"

        CallishMachOp
    MO_F32_Sin    -> String -> LMString
    fsLit String
    "llvm.sin.f32"
        CallishMachOp
    MO_F32_Cos    -> String -> LMString
    fsLit String
    "llvm.cos.f32"
        CallishMachOp
    MO_F32_Tan    -> String -> LMString
    fsLit String
    "tanf"

        CallishMachOp
    MO_F32_Asin   -> String -> LMString
    fsLit String
    "asinf"
        CallishMachOp
    MO_F32_Acos   -> String -> LMString
    fsLit String
    "acosf"
        CallishMachOp
    MO_F32_Atan   -> String -> LMString
    fsLit String
    "atanf"

        CallishMachOp
    MO_F32_Sinh   -> String -> LMString
    fsLit String
    "sinhf"
        CallishMachOp
    MO_F32_Cosh   -> String -> LMString
    fsLit String
    "coshf"
        CallishMachOp
    MO_F32_Tanh   -> String -> LMString
    fsLit String
    "tanhf"

        CallishMachOp
    MO_F32_Asinh  -> String -> LMString
    fsLit String
    "asinhf"
        CallishMachOp
    MO_F32_Acosh  -> String -> LMString
    fsLit String
    "acoshf"
        CallishMachOp
    MO_F32_Atanh  -> String -> LMString
    fsLit String
    "atanhf"

        CallishMachOp
    MO_F64_Exp    -> String -> LMString
    fsLit String
    "exp"
        CallishMachOp
    MO_F64_ExpM1  -> String -> LMString
    fsLit String
    "expm1"
        CallishMachOp
    MO_F64_Log    -> String -> LMString
    fsLit String
    "log"
        CallishMachOp
    MO_F64_Log1P  -> String -> LMString
    fsLit String
    "log1p"
        CallishMachOp
    MO_F64_Sqrt   -> String -> LMString
    fsLit String
    "llvm.sqrt.f64"
        CallishMachOp
    MO_F64_Fabs   -> String -> LMString
    fsLit String
    "llvm.fabs.f64"
        CallishMachOp
    MO_F64_Pwr    -> String -> LMString
    fsLit String
    "llvm.pow.f64"

        CallishMachOp
    MO_F64_Sin    -> String -> LMString
    fsLit String
    "llvm.sin.f64"
        CallishMachOp
    MO_F64_Cos    -> String -> LMString
    fsLit String
    "llvm.cos.f64"
        CallishMachOp
    MO_F64_Tan    -> String -> LMString
    fsLit String
    "tan"

        CallishMachOp
    MO_F64_Asin   -> String -> LMString
    fsLit String
    "asin"
        CallishMachOp
    MO_F64_Acos   -> String -> LMString
    fsLit String
    "acos"
        CallishMachOp
    MO_F64_Atan   -> String -> LMString
    fsLit String
    "atan"

        CallishMachOp
    MO_F64_Sinh   -> String -> LMString
    fsLit String
    "sinh"
        CallishMachOp
    MO_F64_Cosh   -> String -> LMString
    fsLit String
    "cosh"
        CallishMachOp
    MO_F64_Tanh   -> String -> LMString
    fsLit String
    "tanh"

        CallishMachOp
    MO_F64_Asinh  -> String -> LMString
    fsLit String
    "asinh"
        CallishMachOp
    MO_F64_Acosh  -> String -> LMString
    fsLit String
    "acosh"
        CallishMachOp
    MO_F64_Atanh  -> String -> LMString
    fsLit String
    "atanh"

        MO_Memcpy Int
    _   -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.memcpy."  forall a. [a] -> [a] -> [a]
    ++ String
    intrinTy1
        MO_Memmove Int
    _  -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.memmove." forall a. [a] -> [a] -> [a]
    ++ String
    intrinTy1
        MO_Memset Int
    _   -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.memset."  forall a. [a] -> [a] -> [a]
    ++ String
    intrinTy2
        MO_Memcmp Int
    _   -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "memcmp"

        (MO_PopCnt Width
    w) -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.ctpop."      forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        (MO_BSwap Width
    w)  -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.bswap."      forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        (MO_BRev Width
    w)   -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.bitreverse." forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        (MO_Clz Width
    w)    -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.ctlz."       forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        (MO_Ctz Width
    w)    -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.cttz."       forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)

        (MO_Pdep Width
    w)   ->  let w' :: String
    w' = DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBits Width
    w)
                          in  if DynFlags -> Bool
    isBmi2Enabled DynFlags
    dflags
                                then String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.x86.bmi.pdep."   forall a. [a] -> [a] -> [a]
    ++ String
    w'
                                else String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "hs_pdep"              forall a. [a] -> [a] -> [a]
    ++ String
    w'
        (MO_Pext Width
    w)   ->  let w' :: String
    w' = DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBits Width
    w)
                          in  if DynFlags -> Bool
    isBmi2Enabled DynFlags
    dflags
                                then String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.x86.bmi.pext."   forall a. [a] -> [a] -> [a]
    ++ String
    w'
                                else String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "hs_pext"              forall a. [a] -> [a] -> [a]
    ++ String
    w'

        (MO_Prefetch_Data Int
    _ )-> String -> LMString
    fsLit String
    "llvm.prefetch"

        MO_AddIntC Width
    w    -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.sadd.with.overflow."
                                 forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        MO_SubIntC Width
    w    -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.ssub.with.overflow."
                                 forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        MO_Add2 Width
    w       -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.uadd.with.overflow."
                                 forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        MO_AddWordC Width
    w   -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.uadd.with.overflow."
                                 forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)
        MO_SubWordC Width
    w   -> String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.usub.with.overflow."
                                 forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Width -> LlvmType
    widthToLlvmInt Width
    w)

        MO_S_Mul2    {}  -> LMString
    unsupported
        MO_S_QuotRem {}  -> LMString
    unsupported
        MO_U_QuotRem {}  -> LMString
    unsupported
        MO_U_QuotRem2 {} -> LMString
    unsupported
        -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the
        -- appropriate case of genCall.
        MO_U_Mul2 {}     -> LMString
    unsupported
        CallishMachOp
    MO_ReadBarrier   -> LMString
    unsupported
        CallishMachOp
    MO_WriteBarrier  -> LMString
    unsupported
        CallishMachOp
    MO_Touch         -> LMString
    unsupported
        MO_UF_Conv Width
    _     -> LMString
    unsupported

        MO_AtomicRead Width
    _  -> LMString
    unsupported
        MO_AtomicRMW Width
    _ AtomicMachOp
    _ -> LMString
    unsupported
        MO_AtomicWrite Width
    _ -> LMString
    unsupported
        MO_Cmpxchg Width
    _     -> LMString
    unsupported
        MO_Xchg Width
    _        -> LMString
    unsupported

        CallishMachOp
    MO_I64_ToI       -> LMString
    dontReach64
        CallishMachOp
    MO_I64_FromI     -> LMString
    dontReach64
        CallishMachOp
    MO_W64_ToW       -> LMString
    dontReach64
        CallishMachOp
    MO_W64_FromW     -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Neg       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Add       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Sub       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Mul       -> LMString
    dontReach64
        CallishMachOp
    MO_I64_Quot      -> LMString
    dontReach64
        CallishMachOp
    MO_I64_Rem       -> LMString
    dontReach64
        CallishMachOp
    MO_W64_Quot      -> LMString
    dontReach64
        CallishMachOp
    MO_W64_Rem       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_And       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Or        -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Xor       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Not       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Shl       -> LMString
    dontReach64
        CallishMachOp
    MO_I64_Shr       -> LMString
    dontReach64
        CallishMachOp
    MO_W64_Shr       -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Eq        -> LMString
    dontReach64
        CallishMachOp
    MO_x64_Ne        -> LMString
    dontReach64
        CallishMachOp
    MO_I64_Ge        -> LMString
    dontReach64
        CallishMachOp
    MO_I64_Gt        -> LMString
    dontReach64
        CallishMachOp
    MO_I64_Le        -> LMString
    dontReach64
        CallishMachOp
    MO_I64_Lt        -> LMString
    dontReach64
        CallishMachOp
    MO_W64_Ge        -> LMString
    dontReach64
        CallishMachOp
    MO_W64_Gt        -> LMString
    dontReach64
        CallishMachOp
    MO_W64_Le        -> LMString
    dontReach64
        CallishMachOp
    MO_W64_Lt        -> LMString
    dontReach64

    -- | Tail function calls
    genJump :: CmmExpr -> [GlobalReg] -> LlvmM StmtData

    -- Call to known function
    genJump :: CmmExpr -> [GlobalReg] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genJump (CmmLit (CmmLabel CLabel
    lbl)) [GlobalReg]
    live = do
        (LlvmVar
    vf, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- [GlobalReg] -> CLabel -> LlvmM ExprData
    getHsFunc [GlobalReg]
    live CLabel
    lbl
        ([LlvmVar]
    stgRegs, LlvmStatements
    stgStmts) <- [GlobalReg] -> LlvmM ([LlvmVar], LlvmStatements)
    funEpilogue [GlobalReg]
    live
        let s1 :: LlvmStatement
    s1  = LlvmExpression -> LlvmStatement
    Expr forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    TailCall LlvmVar
    vf [LlvmVar]
    stgRegs [LlvmFuncAttr]
    llvmStdFunAttrs
        let s2 :: LlvmStatement
    s2  = Maybe LlvmVar -> LlvmStatement
    Return forall a. Maybe a
    Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stgStmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2, [LlvmCmmDecl]
    top)

    -- Call to unknown function / address
    genJump CmmExpr
    expr [GlobalReg]
    live = do
        LlvmType
    fty <- [GlobalReg] -> LlvmM LlvmType
    llvmFunTy [GlobalReg]
    live
        (LlvmVar
    vf, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    expr
        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

        let cast :: LlvmCastOp
    cast = case LlvmVar -> LlvmType
    getVarType LlvmVar
    vf of
             LlvmType
    ty | LlvmType -> Bool
    isPointer LlvmType
    ty -> LlvmCastOp
    LM_Bitcast
             LlvmType
    ty | LlvmType -> Bool
    isInt LlvmType
    ty     -> LlvmCastOp
    LM_Inttoptr

             LlvmType
    ty -> forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genJump: Expr is of bad type for function call! ("
                         forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr LlvmType
    ty) forall a. [a] -> [a] -> [a]
    ++ String
    ")"

        (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (LlvmType -> LlvmType
    pLift LlvmType
    fty) forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    cast LlvmVar
    vf (LlvmType -> LlvmType
    pLift LlvmType
    fty)
        ([LlvmVar]
    stgRegs, LlvmStatements
    stgStmts) <- [GlobalReg] -> LlvmM ([LlvmVar], LlvmStatements)
    funEpilogue [GlobalReg]
    live
        let s2 :: LlvmStatement
    s2 = LlvmExpression -> LlvmStatement
    Expr forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    TailCall LlvmVar
    v1 [LlvmVar]
    stgRegs [LlvmFuncAttr]
    llvmStdFunAttrs
        let s3 :: LlvmStatement
    s3 = Maybe LlvmVar -> LlvmStatement
    Return forall a. Maybe a
    Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stgStmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s3,
                [LlvmCmmDecl]
    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 :: CmmReg -> CmmExpr -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genAssign CmmReg
    reg CmmExpr
    val = do
        LlvmVar
    vreg <- CmmReg -> LlvmM LlvmVar
    getCmmReg CmmReg
    reg
        (LlvmVar
    vval, LlvmStatements
    stmts2, [LlvmCmmDecl]
    top2) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    val
        let stmts :: LlvmStatements
    stmts = LlvmStatements
    stmts2

        let ty :: LlvmType
    ty = (LlvmType -> LlvmType
    pLower forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmVar -> LlvmType
    getVarType) LlvmVar
    vreg
        Platform
    platform <- LlvmM Platform
    getPlatform
        case LlvmType
    ty of
          -- Some registers are pointer types, so need to cast value to pointer
          LMPointer LlvmType
    _ | LlvmVar -> LlvmType
    getVarType LlvmVar
    vval forall a. Eq a => a -> a -> Bool
    == Platform -> LlvmType
    llvmWord Platform
    platform -> do
              (LlvmVar
    v, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    vval LlvmType
    ty
              let s2 :: LlvmStatement
    s2 = LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    v LlvmVar
    vreg forall a. Maybe a
    Nothing
              forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2, [LlvmCmmDecl]
    top2)

          LMVector Int
    _ LlvmType
    _ -> do
              (LlvmVar
    v, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Bitcast LlvmVar
    vval LlvmType
    ty
              let s2 :: LlvmStatement
    s2 = LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore LlvmVar
    v LlvmVar
    vreg AlignmentSpec
    NaturallyAligned
              forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2, [LlvmCmmDecl]
    top2)

          LlvmType
    _ -> do
              let s1 :: LlvmStatement
    s1 = LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    vval LlvmVar
    vreg forall a. Maybe a
    Nothing
              forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top2)

    -- | CmmStore operation
    genStore :: CmmExpr -> CmmExpr -> AlignmentSpec -> 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 :: CmmExpr
    -> CmmExpr
    -> AlignmentSpec
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore addr :: CmmExpr
    addr@(CmmReg (CmmGlobal GlobalReg
    r)) CmmExpr
    val AlignmentSpec
    alignment
        = CmmExpr
    -> GlobalReg
    -> Int
    -> CmmExpr
    -> AlignmentSpec
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_fast CmmExpr
    addr GlobalReg
    r Int
    0 CmmExpr
    val AlignmentSpec
    alignment

    genStore addr :: CmmExpr
    addr@(CmmRegOff (CmmGlobal GlobalReg
    r) Int
    n) CmmExpr
    val AlignmentSpec
    alignment
        = CmmExpr
    -> GlobalReg
    -> Int
    -> CmmExpr
    -> AlignmentSpec
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_fast CmmExpr
    addr GlobalReg
    r Int
    n CmmExpr
    val AlignmentSpec
    alignment

    genStore addr :: CmmExpr
    addr@(CmmMachOp (MO_Add Width
    _) [
                                (CmmReg (CmmGlobal GlobalReg
    r)),
                                (CmmLit (CmmInt Integer
    n Width
    _))])
                    CmmExpr
    val AlignmentSpec
    alignment
        = CmmExpr
    -> GlobalReg
    -> Int
    -> CmmExpr
    -> AlignmentSpec
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_fast CmmExpr
    addr GlobalReg
    r (forall a. Num a => Integer -> a
    fromInteger Integer
    n) CmmExpr
    val AlignmentSpec
    alignment

    genStore addr :: CmmExpr
    addr@(CmmMachOp (MO_Sub Width
    _) [
                                (CmmReg (CmmGlobal GlobalReg
    r)),
                                (CmmLit (CmmInt Integer
    n Width
    _))])
                    CmmExpr
    val AlignmentSpec
    alignment
        = CmmExpr
    -> GlobalReg
    -> Int
    -> CmmExpr
    -> AlignmentSpec
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_fast CmmExpr
    addr GlobalReg
    r (forall a. Num a => a -> a
    negate forall a b. (a -> b) -> a -> b
    $ forall a. Num a => Integer -> a
    fromInteger Integer
    n) CmmExpr
    val AlignmentSpec
    alignment

    -- generic case
    genStore CmmExpr
    addr CmmExpr
    val AlignmentSpec
    alignment
        = Unique -> LlvmM [MetaAnnot]
    getTBAAMeta Unique
    topN forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CmmExpr
    -> CmmExpr
    -> AlignmentSpec
    -> [MetaAnnot]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_slow CmmExpr
    addr CmmExpr
    val AlignmentSpec
    alignment

    -- | 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 -> AlignmentSpec
                  -> LlvmM StmtData
    genStore_fast :: CmmExpr
    -> GlobalReg
    -> Int
    -> CmmExpr
    -> AlignmentSpec
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_fast CmmExpr
    addr GlobalReg
    r Int
    n CmmExpr
    val AlignmentSpec
    alignment
      = do Platform
    platform <- LlvmM Platform
    getPlatform
           (LlvmVar
    gv, LlvmType
    grt, LlvmStatements
    s1) <- CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
    getCmmRegVal (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    r)
           [MetaAnnot]
    meta          <- GlobalReg -> LlvmM [MetaAnnot]
    getTBAARegMeta GlobalReg
    r
           let (Int
    ix,Int
    rem) = Int
    n forall a. Integral a => a -> a -> (a, a)
    `divMod` ((Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmType -> LlvmType
    pLower) LlvmType
    grt  forall a. Integral a => a -> a -> a
    `div` Int
    8)
           case LlvmType -> Bool
    isPointer LlvmType
    grt Bool -> Bool -> Bool
    && Int
    rem forall a. Eq a => a -> a -> Bool
    == Int
    0 of
                Bool
    True -> do
                    (LlvmVar
    vval,  LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    val
                    (LlvmVar
    ptr, LlvmStatement
    s2) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    grt forall a b. (a -> b) -> a -> b
    $ Bool -> LlvmVar -> [LlvmVar] -> LlvmExpression
    GetElemPtr Bool
    True LlvmVar
    gv [forall a. Integral a => a -> LlvmVar
    toI32 Int
    ix]
                    -- We might need a different pointer type, so check
                    case LlvmType -> LlvmType
    pLower LlvmType
    grt forall a. Eq a => a -> a -> Bool
    == LlvmVar -> LlvmType
    getVarType LlvmVar
    vval of
                         -- were fine
                         Bool
    True  -> do
                             let s3 :: LlvmStatement
    s3 = [MetaAnnot] -> LlvmStatement -> LlvmStatement
    MetaStmt [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore LlvmVar
    vval LlvmVar
    ptr AlignmentSpec
    alignment
                             forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2
                                     forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s3, [LlvmCmmDecl]
    top)

                         -- cast to pointer type needed
                         Bool
    False -> do
                             let ty :: LlvmType
    ty = (LlvmType -> LlvmType
    pLift forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmVar -> LlvmType
    getVarType) LlvmVar
    vval
                             (LlvmVar
    ptr', LlvmStatement
    s3) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Bitcast LlvmVar
    ptr LlvmType
    ty
                             let s4 :: LlvmStatement
    s4 = [MetaAnnot] -> LlvmStatement -> LlvmStatement
    MetaStmt [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore LlvmVar
    vval LlvmVar
    ptr' AlignmentSpec
    alignment
                             forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2
                                     forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s3 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s4, [LlvmCmmDecl]
    top)

                -- If its a bit type then we use the slow method since
                -- we can't avoid casting anyway.
                Bool
    False -> CmmExpr
    -> CmmExpr
    -> AlignmentSpec
    -> [MetaAnnot]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_slow CmmExpr
    addr CmmExpr
    val AlignmentSpec
    alignment [MetaAnnot]
    meta

    -- | CmmStore operation
    -- Generic case. Uses casts and pointer arithmetic if needed.
    genStore_slow :: CmmExpr -> CmmExpr -> AlignmentSpec -> [MetaAnnot] -> LlvmM StmtData
    genStore_slow :: CmmExpr
    -> CmmExpr
    -> AlignmentSpec
    -> [MetaAnnot]
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genStore_slow CmmExpr
    addr CmmExpr
    val AlignmentSpec
    alignment [MetaAnnot]
    meta = do
        (LlvmVar
    vaddr, LlvmStatements
    stmts1, [LlvmCmmDecl]
    top1) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    addr
        (LlvmVar
    vval,  LlvmStatements
    stmts2, [LlvmCmmDecl]
    top2) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    val

        let stmts :: LlvmStatements
    stmts = LlvmStatements
    stmts1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts2
        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Platform
    platform <- LlvmM Platform
    getPlatform
        LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
        case LlvmVar -> LlvmType
    getVarType LlvmVar
    vaddr of
            -- sometimes we need to cast an int to a pointer before storing
            LMPointer ty :: LlvmType
    ty@(LMPointer LlvmType
    _) | LlvmVar -> LlvmType
    getVarType LlvmVar
    vval forall a. Eq a => a -> a -> Bool
    == Platform -> LlvmType
    llvmWord Platform
    platform -> do
                (LlvmVar
    v, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    vval LlvmType
    ty
                let s2 :: LlvmStatement
    s2 = [MetaAnnot] -> LlvmStatement -> LlvmStatement
    MetaStmt [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore LlvmVar
    v LlvmVar
    vaddr AlignmentSpec
    alignment
                forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2, [LlvmCmmDecl]
    top1 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top2)

            LMPointer LlvmType
    _ -> do
                let s1 :: LlvmStatement
    s1 = [MetaAnnot] -> LlvmStatement -> LlvmStatement
    MetaStmt [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore LlvmVar
    vval LlvmVar
    vaddr AlignmentSpec
    alignment
                forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top1 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top2)

            i :: LlvmType
    i@(LMInt Int
    _) | LlvmType
    i forall a. Eq a => a -> a -> Bool
    == Platform -> LlvmType
    llvmWord Platform
    platform -> do
                let vty :: LlvmType
    vty = LlvmType -> LlvmType
    pLift forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    vval
                (LlvmVar
    vptr, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    vty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    vaddr LlvmType
    vty
                let s2 :: LlvmStatement
    s2 = [MetaAnnot] -> LlvmStatement -> LlvmStatement
    MetaStmt [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore LlvmVar
    vval LlvmVar
    vptr AlignmentSpec
    alignment
                forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2, [LlvmCmmDecl]
    top1 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top2)

            LlvmType
    other ->
                forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genStore: ptr not right type!"
                        (Platform -> CmmExpr -> SDoc
    PprCmm.pprExpr Platform
    platform CmmExpr
    addr SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text (
                            String
    "Size of Ptr: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (Platform -> Int
    llvmPtrBits Platform
    platform) forall a. [a] -> [a] -> [a]
    ++
                            String
    ", Size of var: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    other) forall a. [a] -> [a] -> [a]
    ++
                            String
    ", Var: " forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (LlvmOpts -> LlvmVar -> SDoc
    ppVar LlvmOpts
    opts LlvmVar
    vaddr)))

    mkStore :: LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore :: LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
    mkStore LlvmVar
    vval LlvmVar
    vptr AlignmentSpec
    alignment =
        LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    vval LlvmVar
    vptr LMAlign
    align
      where
        ty :: LlvmType
    ty = LlvmType -> LlvmType
    pLower (LlvmVar -> LlvmType
    getVarType LlvmVar
    vptr)
        align :: LMAlign
    align = case AlignmentSpec
    alignment of
                  -- See Note [Alignment of vector-typed values]
                  AlignmentSpec
    _ | LlvmType -> Bool
    isVector LlvmType
    ty  -> forall a. a -> Maybe a
    Just Int
    1
                  AlignmentSpec
    Unaligned        -> forall a. a -> Maybe a
    Just Int
    1
                  AlignmentSpec
    NaturallyAligned -> forall a. Maybe a
    Nothing

    -- | Unconditional branch
    genBranch :: BlockId -> LlvmM StmtData
    genBranch :: BlockId -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genBranch BlockId
    id =
        let label :: LlvmVar
    label = BlockId -> LlvmVar
    blockIdToLlvm BlockId
    id
        in forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmStatement
    Branch LlvmVar
    label, [])

    -- | Conditional branch
    genCondBranch :: CmmExpr -> BlockId -> BlockId -> Maybe Bool -> LlvmM StmtData
    genCondBranch :: CmmExpr
    -> BlockId
    -> BlockId
    -> Maybe Bool
    -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genCondBranch CmmExpr
    cond BlockId
    idT BlockId
    idF Maybe Bool
    likely = do
        let labelT :: LlvmVar
    labelT = BlockId -> LlvmVar
    blockIdToLlvm BlockId
    idT
        let labelF :: LlvmVar
    labelF = BlockId -> LlvmVar
    blockIdToLlvm BlockId
    idF
        -- See Note [Literals and branch conditions].
        (LlvmVar
    vc, LlvmStatements
    stmts1, [LlvmCmmDecl]
    top1) <- EOption -> CmmExpr -> LlvmM ExprData
    exprToVarOpt EOption
    i1Option CmmExpr
    cond
        if LlvmVar -> LlvmType
    getVarType LlvmVar
    vc forall a. Eq a => a -> a -> Bool
    == LlvmType
    i1
            then do
                (LlvmVar
    vc', (LlvmStatements
    stmts2, [LlvmCmmDecl]
    top2)) <- case Maybe Bool
    likely of
                  Just Bool
    b -> Integer
    -> LlvmType
    -> LlvmVar
    -> LlvmM (LlvmVar, (LlvmStatements, [LlvmCmmDecl]))
    genExpectLit (if Bool
    b then Integer
    1 else Integer
    0) LlvmType
    i1  LlvmVar
    vc
                  Maybe Bool
    _      -> forall (f :: * -> *) a. Applicative f => a -> f a
    pure (LlvmVar
    vc, (forall a. OrdList a
    nilOL, []))
                let s1 :: LlvmStatement
    s1 = LlvmVar -> LlvmVar -> LlvmVar -> LlvmStatement
    BranchIf LlvmVar
    vc' LlvmVar
    labelT LlvmVar
    labelF
                forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top1 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    top2)
            else do
                DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
                forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genCondBranch: Cond expr not bool! (" forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (LlvmOpts -> LlvmVar -> SDoc
    ppVar LlvmOpts
    opts LlvmVar
    vc) forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    -- | Generate call to llvm.expect.x intrinsic. Assigning result to a new var.
    genExpectLit :: Integer -> LlvmType -> LlvmVar -> LlvmM (LlvmVar, StmtData)
    genExpectLit :: Integer
    -> LlvmType
    -> LlvmVar
    -> LlvmM (LlvmVar, (LlvmStatements, [LlvmCmmDecl]))
    genExpectLit Integer
    expLit LlvmType
    expTy LlvmVar
    var = do
      DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

      let
        lit :: LlvmVar
    lit = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit Integer
    expLit LlvmType
    expTy

        llvmExpectName :: LMString
    llvmExpectName
          | LlvmType -> Bool
    isInt LlvmType
    expTy = String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ String
    "llvm.expect." forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr LlvmType
    expTy)
          | Bool
    otherwise   = forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genExpectedLit: Type not an int!"

      (LlvmVar
    llvmExpect, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <-
        LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData
    getInstrinct LMString
    llvmExpectName LlvmType
    expTy [LlvmType
    expTy, LlvmType
    expTy]
      (LlvmVar
    var', LlvmStatement
    call) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    expTy forall a b. (a -> b) -> a -> b
    $ LlvmCallType
    -> LlvmVar -> [LlvmVar] -> [LlvmFuncAttr] -> LlvmExpression
    Call LlvmCallType
    StdCall LlvmVar
    llvmExpect [LlvmVar
    var, LlvmVar
    lit] []
      forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    var', (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    call, [LlvmCmmDecl]
    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 :: CmmExpr -> SwitchTargets -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    genSwitch CmmExpr
    cond SwitchTargets
    ids = do
        (LlvmVar
    vc, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    cond
        let ty :: LlvmType
    ty = LlvmVar -> LlvmType
    getVarType LlvmVar
    vc

        let labels :: [(LlvmVar, LlvmVar)]
    labels = [ (forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    ty Integer
    ix, BlockId -> LlvmVar
    blockIdToLlvm BlockId
    b)
                     | (Integer
    ix, BlockId
    b) <- SwitchTargets -> [(Integer, BlockId)]
    switchTargetsCases SwitchTargets
    ids ]
        -- out of range is undefined, so let's just branch to first label
        let defLbl :: LlvmVar
    defLbl | Just BlockId
    l <- SwitchTargets -> Maybe BlockId
    switchTargetsDefault SwitchTargets
    ids = BlockId -> LlvmVar
    blockIdToLlvm BlockId
    l
                   | Bool
    otherwise                          = forall a b. (a, b) -> b
    snd (forall {a}. [a] -> a
    head [(LlvmVar, LlvmVar)]
    labels)

        let s1 :: LlvmStatement
    s1 = LlvmVar -> LlvmVar -> [(LlvmVar, LlvmVar)] -> LlvmStatement
    Switch LlvmVar
    vc LlvmVar
    defLbl [(LlvmVar, LlvmVar)]
    labels
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ (LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    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 { EOption -> Bool
    i1Expected :: Bool }
    -- XXX: EOption is an ugly and inefficient solution to this problem.

    -- | i1 type expected (condition scrutinee).
    i1Option :: EOption
    i1Option :: EOption
    i1Option = Bool -> EOption
    EOption Bool
    True

    -- | Word type expected (usual).
    wordOption :: EOption
    wordOption :: EOption
    wordOption = Bool -> EOption
    EOption Bool
    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 :: CmmExpr -> LlvmM ExprData
    exprToVar = EOption -> CmmExpr -> LlvmM ExprData
    exprToVarOpt EOption
    wordOption

    exprToVarOpt :: EOption -> CmmExpr -> LlvmM ExprData
    exprToVarOpt :: EOption -> CmmExpr -> LlvmM ExprData
    exprToVarOpt EOption
    opt CmmExpr
    e = case CmmExpr
    e of

        CmmLit CmmLit
    lit
            -> EOption -> CmmLit -> LlvmM ExprData
    genLit EOption
    opt CmmLit
    lit

        CmmLoad CmmExpr
    e' CmmType
    ty AlignmentSpec
    align
            -> Bool -> CmmExpr -> CmmType -> AlignmentSpec -> LlvmM ExprData
    genLoad Bool
    False CmmExpr
    e' CmmType
    ty AlignmentSpec
    align

        -- Cmmreg in expression is the value, so must load. If you want actual
        -- reg pointer, call getCmmReg directly.
        CmmReg CmmReg
    r -> do
            (LlvmVar
    v1, LlvmType
    ty, LlvmStatements
    s1) <- CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
    getCmmRegVal CmmReg
    r
            case LlvmType -> Bool
    isPointer LlvmType
    ty of
                 Bool
    True  -> do
                     -- Cmm wants the value, so pointer types must be cast to ints
                     Platform
    platform <- LlvmM Platform
    getPlatform
                     (LlvmVar
    v2, LlvmStatement
    s2) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (Platform -> LlvmType
    llvmWord Platform
    platform) forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Ptrtoint LlvmVar
    v1 (Platform -> LlvmType
    llvmWord Platform
    platform)
                     forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v2, LlvmStatements
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2, [])

                 Bool
    False -> forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v1, LlvmStatements
    s1, [])

        CmmMachOp MachOp
    op [CmmExpr]
    exprs
            -> EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData
    genMachOp EOption
    opt MachOp
    op [CmmExpr]
    exprs

        CmmRegOff CmmReg
    r Int
    i
            -> do Platform
    platform <- LlvmM Platform
    getPlatform
                  CmmExpr -> LlvmM ExprData
    exprToVar forall a b. (a -> b) -> a -> b
    $ Platform -> (CmmReg, Int) -> CmmExpr
    expandCmmReg Platform
    platform (CmmReg
    r, Int
    i)

        CmmStackSlot Area
    _ Int
    _
            -> forall a. HasCallStack => String -> a
    panic String
    "exprToVar: CmmStackSlot not supported!"

    -- | Handle CmmMachOp expressions
    genMachOp :: EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData

    -- Unary Machop
    genMachOp :: EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData
    genMachOp EOption
    _ MachOp
    op [CmmExpr
    x] = case MachOp
    op of

        MO_Not Width
    w ->
            let all1 :: LlvmVar
    all1 = forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit (Width -> LlvmType
    widthToLlvmInt Width
    w) (-Integer
    1)
            in LlvmType -> LlvmVar -> LlvmMachOp -> LlvmM ExprData
    negate (Width -> LlvmType
    widthToLlvmInt Width
    w) LlvmVar
    all1 LlvmMachOp
    LM_MO_Xor

        MO_S_Neg Width
    w ->
            let all0 :: LlvmVar
    all0 = forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit (Width -> LlvmType
    widthToLlvmInt Width
    w) Integer
    0
            in LlvmType -> LlvmVar -> LlvmMachOp -> LlvmM ExprData
    negate (Width -> LlvmType
    widthToLlvmInt Width
    w) LlvmVar
    all0 LlvmMachOp
    LM_MO_Sub

        MO_F_Neg Width
    w ->
            let all0 :: LlvmVar
    all0 = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Double -> LlvmType -> LlvmLit
    LMFloatLit (-Double
    0) (Width -> LlvmType
    widthToLlvmFloat Width
    w)
            in LlvmType -> LlvmVar -> LlvmMachOp -> LlvmM ExprData
    negate (Width -> LlvmType
    widthToLlvmFloat Width
    w) LlvmVar
    all0 LlvmMachOp
    LM_MO_FSub

        MO_SF_Conv Width
    _ Width
    w -> LlvmType -> LlvmCastOp -> LlvmM ExprData
    fiConv (Width -> LlvmType
    widthToLlvmFloat Width
    w) LlvmCastOp
    LM_Sitofp
        MO_FS_Conv Width
    _ Width
    w -> LlvmType -> LlvmCastOp -> LlvmM ExprData
    fiConv (Width -> LlvmType
    widthToLlvmInt Width
    w) LlvmCastOp
    LM_Fptosi

        MO_SS_Conv Width
    from Width
    to
            -> Width -> LlvmType -> LlvmCastOp -> LlvmCastOp -> LlvmM ExprData
    sameConv Width
    from (Width -> LlvmType
    widthToLlvmInt Width
    to) LlvmCastOp
    LM_Trunc LlvmCastOp
    LM_Sext

        MO_UU_Conv Width
    from Width
    to
            -> Width -> LlvmType -> LlvmCastOp -> LlvmCastOp -> LlvmM ExprData
    sameConv Width
    from (Width -> LlvmType
    widthToLlvmInt Width
    to) LlvmCastOp
    LM_Trunc LlvmCastOp
    LM_Zext

        MO_XX_Conv Width
    from Width
    to
            -> Width -> LlvmType -> LlvmCastOp -> LlvmCastOp -> LlvmM ExprData
    sameConv Width
    from (Width -> LlvmType
    widthToLlvmInt Width
    to) LlvmCastOp
    LM_Trunc LlvmCastOp
    LM_Zext

        MO_FF_Conv Width
    from Width
    to
            -> Width -> LlvmType -> LlvmCastOp -> LlvmCastOp -> LlvmM ExprData
    sameConv Width
    from (Width -> LlvmType
    widthToLlvmFloat Width
    to) LlvmCastOp
    LM_Fptrunc LlvmCastOp
    LM_Fpext

        MO_VS_Neg Int
    len Width
    w ->
            let ty :: LlvmType
    ty    = Width -> LlvmType
    widthToLlvmInt Width
    w
                vecty :: LlvmType
    vecty = Int -> LlvmType -> LlvmType
    LMVector Int
    len LlvmType
    ty
                all0 :: LlvmLit
    all0  = Integer -> LlvmType -> LlvmLit
    LMIntLit (-Integer
    0) LlvmType
    ty
                all0s :: LlvmVar
    all0s = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ [LlvmLit] -> LlvmLit
    LMVectorLit (forall a. Int -> a -> [a]
    replicate Int
    len LlvmLit
    all0)
            in LlvmType -> LlvmVar -> LlvmMachOp -> LlvmM ExprData
    negateVec LlvmType
    vecty LlvmVar
    all0s LlvmMachOp
    LM_MO_Sub

        MO_VF_Neg Int
    len Width
    w ->
            let ty :: LlvmType
    ty    = Width -> LlvmType
    widthToLlvmFloat Width
    w
                vecty :: LlvmType
    vecty = Int -> LlvmType -> LlvmType
    LMVector Int
    len LlvmType
    ty
                all0 :: LlvmLit
    all0  = Double -> LlvmType -> LlvmLit
    LMFloatLit (-Double
    0) LlvmType
    ty
                all0s :: LlvmVar
    all0s = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ [LlvmLit] -> LlvmLit
    LMVectorLit (forall a. Int -> a -> [a]
    replicate Int
    len LlvmLit
    all0)
            in LlvmType -> LlvmVar -> LlvmMachOp -> LlvmM ExprData
    negateVec LlvmType
    vecty LlvmVar
    all0s LlvmMachOp
    LM_MO_FSub

        MO_AlignmentCheck Int
    _ Width
    _ -> forall a. HasCallStack => String -> a
    panic String
    "-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 Width
    _          -> LlvmM ExprData
    panicOp
        MO_Mul Width
    _          -> LlvmM ExprData
    panicOp
        MO_Sub Width
    _          -> LlvmM ExprData
    panicOp
        MO_S_MulMayOflo Width
    _ -> LlvmM ExprData
    panicOp
        MO_S_Quot Width
    _       -> LlvmM ExprData
    panicOp
        MO_S_Rem Width
    _        -> LlvmM ExprData
    panicOp
        MO_U_MulMayOflo Width
    _ -> LlvmM ExprData
    panicOp
        MO_U_Quot Width
    _       -> LlvmM ExprData
    panicOp
        MO_U_Rem Width
    _        -> LlvmM ExprData
    panicOp

        MO_Eq  Width
    _          -> LlvmM ExprData
    panicOp
        MO_Ne  Width
    _          -> LlvmM ExprData
    panicOp
        MO_S_Ge Width
    _         -> LlvmM ExprData
    panicOp
        MO_S_Gt Width
    _         -> LlvmM ExprData
    panicOp
        MO_S_Le Width
    _         -> LlvmM ExprData
    panicOp
        MO_S_Lt Width
    _         -> LlvmM ExprData
    panicOp
        MO_U_Ge Width
    _         -> LlvmM ExprData
    panicOp
        MO_U_Gt Width
    _         -> LlvmM ExprData
    panicOp
        MO_U_Le Width
    _         -> LlvmM ExprData
    panicOp
        MO_U_Lt Width
    _         -> LlvmM ExprData
    panicOp

        MO_F_Add        Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Sub        Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Mul        Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Quot       Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Eq         Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Ne         Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Ge         Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Gt         Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Le         Width
    _ -> LlvmM ExprData
    panicOp
        MO_F_Lt         Width
    _ -> LlvmM ExprData
    panicOp

        MO_And          Width
    _ -> LlvmM ExprData
    panicOp
        MO_Or           Width
    _ -> LlvmM ExprData
    panicOp
        MO_Xor          Width
    _ -> LlvmM ExprData
    panicOp
        MO_Shl          Width
    _ -> LlvmM ExprData
    panicOp
        MO_U_Shr        Width
    _ -> LlvmM ExprData
    panicOp
        MO_S_Shr        Width
    _ -> LlvmM ExprData
    panicOp

        MO_V_Insert   Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_V_Extract  Int
    _ Width
    _ -> LlvmM ExprData
    panicOp

        MO_V_Add      Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_V_Sub      Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_V_Mul      Int
    _ Width
    _ -> LlvmM ExprData
    panicOp

        MO_VS_Quot    Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_VS_Rem     Int
    _ Width
    _ -> LlvmM ExprData
    panicOp

        MO_VU_Quot    Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_VU_Rem     Int
    _ Width
    _ -> LlvmM ExprData
    panicOp

        MO_VF_Insert  Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_VF_Extract Int
    _ Width
    _ -> LlvmM ExprData
    panicOp

        MO_VF_Add     Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_VF_Sub     Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_VF_Mul     Int
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_VF_Quot    Int
    _ Width
    _ -> LlvmM ExprData
    panicOp

        where
            negate :: LlvmType -> LlvmVar -> LlvmMachOp -> LlvmM ExprData
    negate LlvmType
    ty LlvmVar
    v2 LlvmMachOp
    negOp = do
                (LlvmVar
    vx, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    x
                (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    negOp LlvmVar
    v2 LlvmVar
    vx
                forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v1, LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top)

            negateVec :: LlvmType -> LlvmVar -> LlvmMachOp -> LlvmM ExprData
    negateVec LlvmType
    ty LlvmVar
    v2 LlvmMachOp
    negOp = do
                (LlvmVar
    vx, LlvmStatements
    stmts1, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    x
                ([LlvmVar]
    vxs', LlvmStatements
    stmts2) <- Signage
    -> [(LlvmVar, LlvmType)] -> LlvmM ([LlvmVar], LlvmStatements)
    castVars Signage
    Signed [(LlvmVar
    vx, LlvmType
    ty)]
                let vx' :: LlvmVar
    vx' = forall a. String -> [a] -> a
    singletonPanic String
    "genMachOp: negateVec" [LlvmVar]
    vxs'
                (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    negOp LlvmVar
    v2 LlvmVar
    vx'
                forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v1, LlvmStatements
    stmts1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top)

            fiConv :: LlvmType -> LlvmCastOp -> LlvmM ExprData
    fiConv LlvmType
    ty LlvmCastOp
    convOp = do
                (LlvmVar
    vx, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    x
                (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    convOp LlvmVar
    vx LlvmType
    ty
                forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v1, LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top)

            sameConv :: Width -> LlvmType -> LlvmCastOp -> LlvmCastOp -> LlvmM ExprData
    sameConv Width
    from LlvmType
    ty LlvmCastOp
    reduce LlvmCastOp
    expand = do
                x' :: ExprData
    x'@(LlvmVar
    vx, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- CmmExpr -> LlvmM ExprData
    exprToVar CmmExpr
    x
                let sameConv' :: LlvmCastOp -> LlvmM ExprData
    sameConv' LlvmCastOp
    op = do
                        (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    op LlvmVar
    vx LlvmType
    ty
                        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v1, LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top)
                Platform
    platform <- LlvmM Platform
    getPlatform
                let toWidth :: Int
    toWidth = Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    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 Width -> Int
    widthInBits Width
    from  of
                     Int
    w | Int
    w forall a. Ord a => a -> a -> Bool
    < Int
    toWidth -> LlvmCastOp -> LlvmM ExprData
    sameConv' LlvmCastOp
    expand
                     Int
    w | Int
    w forall a. Ord a => a -> a -> Bool
    > Int
    toWidth -> LlvmCastOp -> LlvmM ExprData
    sameConv' LlvmCastOp
    reduce
                     Int
    _w              -> forall (m :: * -> *) a. Monad m => a -> m a
    return ExprData
    x'

            panicOp :: LlvmM ExprData
    panicOp = forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "LLVM.CodeGen.genMachOp: non unary op encountered"
                           forall a. [a] -> [a] -> [a]
    ++ String
    "with one argument! (" forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show MachOp
    op forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    -- Handle GlobalRegs pointers
    genMachOp EOption
    opt o :: MachOp
    o@(MO_Add Width
    _) e :: [CmmExpr]
    e@[(CmmReg (CmmGlobal GlobalReg
    r)), (CmmLit (CmmInt Integer
    n Width
    _))]
        = EOption
    -> MachOp -> GlobalReg -> Int -> [CmmExpr] -> LlvmM ExprData
    genMachOp_fast EOption
    opt MachOp
    o GlobalReg
    r (forall a. Num a => Integer -> a
    fromInteger Integer
    n) [CmmExpr]
    e

    genMachOp EOption
    opt o :: MachOp
    o@(MO_Sub Width
    _) e :: [CmmExpr]
    e@[(CmmReg (CmmGlobal GlobalReg
    r)), (CmmLit (CmmInt Integer
    n Width
    _))]
        = EOption
    -> MachOp -> GlobalReg -> Int -> [CmmExpr] -> LlvmM ExprData
    genMachOp_fast EOption
    opt MachOp
    o GlobalReg
    r (forall a. Num a => a -> a
    negate forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. Num a => Integer -> a
    fromInteger forall a b. (a -> b) -> a -> b
    $ Integer
    n) [CmmExpr]
    e

    -- Generic case
    genMachOp EOption
    opt MachOp
    op [CmmExpr]
    e = EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData
    genMachOp_slow EOption
    opt MachOp
    op [CmmExpr]
    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 :: EOption
    -> MachOp -> GlobalReg -> Int -> [CmmExpr] -> LlvmM ExprData
    genMachOp_fast EOption
    opt MachOp
    op GlobalReg
    r Int
    n [CmmExpr]
    e
      = do (LlvmVar
    gv, LlvmType
    grt, LlvmStatements
    s1) <- CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
    getCmmRegVal (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    r)
           Platform
    platform <- LlvmM Platform
    getPlatform
           let (Int
    ix,Int
    rem) = Int
    n forall a. Integral a => a -> a -> (a, a)
    `divMod` ((Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmType -> LlvmType
    pLower) LlvmType
    grt  forall a. Integral a => a -> a -> a
    `div` Int
    8)
           case LlvmType -> Bool
    isPointer LlvmType
    grt Bool -> Bool -> Bool
    && Int
    rem forall a. Eq a => a -> a -> Bool
    == Int
    0 of
                Bool
    True -> do
                    (LlvmVar
    ptr, LlvmStatement
    s2) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    grt forall a b. (a -> b) -> a -> b
    $ Bool -> LlvmVar -> [LlvmVar] -> LlvmExpression
    GetElemPtr Bool
    True LlvmVar
    gv [forall a. Integral a => a -> LlvmVar
    toI32 Int
    ix]
                    (LlvmVar
    var, LlvmStatement
    s3) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (Platform -> LlvmType
    llvmWord Platform
    platform) forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Ptrtoint LlvmVar
    ptr (Platform -> LlvmType
    llvmWord Platform
    platform)
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    var, LlvmStatements
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s3, [])

                Bool
    False -> EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData
    genMachOp_slow EOption
    opt MachOp
    op [CmmExpr]
    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 :: EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData
    genMachOp_slow EOption
    _ (MO_V_Extract Int
    l Width
    w) [CmmExpr
    val, CmmExpr
    idx] = WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    vval <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    val
        LlvmVar
    vidx <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    idx
        LlvmVar
    vval' <- forall a. String -> [a] -> a
    singletonPanic String
    "genMachOp_slow" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                 Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed [(LlvmVar
    vval, Int -> LlvmType -> LlvmType
    LMVector Int
    l LlvmType
    ty)]
        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmExpression
    Extract LlvmVar
    vval' LlvmVar
    vidx
      where
        ty :: LlvmType
    ty = Width -> LlvmType
    widthToLlvmInt Width
    w

    genMachOp_slow EOption
    _ (MO_VF_Extract Int
    l Width
    w) [CmmExpr
    val, CmmExpr
    idx] = WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    vval <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    val
        LlvmVar
    vidx <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    idx
        LlvmVar
    vval' <- forall a. String -> [a] -> a
    singletonPanic String
    "genMachOp_slow" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                 Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed [(LlvmVar
    vval, Int -> LlvmType -> LlvmType
    LMVector Int
    l LlvmType
    ty)]
        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmExpression
    Extract LlvmVar
    vval' LlvmVar
    vidx
      where
        ty :: LlvmType
    ty = Width -> LlvmType
    widthToLlvmFloat Width
    w

    -- Element insertion
    genMachOp_slow EOption
    _ (MO_V_Insert Int
    l Width
    w) [CmmExpr
    val, CmmExpr
    elt, CmmExpr
    idx] = WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    vval <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    val
        LlvmVar
    velt <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    elt
        LlvmVar
    vidx <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    idx
        LlvmVar
    vval' <- forall a. String -> [a] -> a
    singletonPanic String
    "genMachOp_slow" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                 Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed [(LlvmVar
    vval, LlvmType
    ty)]
        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmVar -> LlvmExpression
    Insert LlvmVar
    vval' LlvmVar
    velt LlvmVar
    vidx
      where
        ty :: LlvmType
    ty = Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)

    genMachOp_slow EOption
    _ (MO_VF_Insert Int
    l Width
    w) [CmmExpr
    val, CmmExpr
    elt, CmmExpr
    idx] = WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    vval <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    val
        LlvmVar
    velt <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    elt
        LlvmVar
    vidx <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    idx
        LlvmVar
    vval' <- forall a. String -> [a] -> a
    singletonPanic String
    "genMachOp_slow" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                 Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed [(LlvmVar
    vval, LlvmType
    ty)]
        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmVar -> LlvmExpression
    Insert LlvmVar
    vval' LlvmVar
    velt LlvmVar
    vidx
      where
        ty :: LlvmType
    ty = Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmFloat Width
    w)

    -- Binary MachOp
    genMachOp_slow EOption
    opt MachOp
    op [CmmExpr
    x, CmmExpr
    y] = case MachOp
    op of

        MO_Eq Width
    _   -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Eq
        MO_Ne Width
    _   -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Ne

        MO_S_Gt Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Sgt
        MO_S_Ge Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Sge
        MO_S_Lt Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Slt
        MO_S_Le Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Sle

        MO_U_Gt Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Ugt
        MO_U_Ge Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Uge
        MO_U_Lt Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Ult
        MO_U_Le Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Ule

        MO_Add Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_Add
        MO_Sub Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_Sub
        MO_Mul Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_Mul

        MO_U_MulMayOflo Width
    _ -> forall a. HasCallStack => String -> a
    panic String
    "genMachOp: MO_U_MulMayOflo unsupported!"

        MO_S_MulMayOflo Width
    w -> Width -> CmmExpr -> CmmExpr -> LlvmM ExprData
    isSMulOK Width
    w CmmExpr
    x CmmExpr
    y

        MO_S_Quot Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_SDiv
        MO_S_Rem  Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_SRem

        MO_U_Quot Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_UDiv
        MO_U_Rem  Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_URem

        MO_F_Eq Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Feq
        MO_F_Ne Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Fne
        MO_F_Gt Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Fgt
        MO_F_Ge Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Fge
        MO_F_Lt Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Flt
        MO_F_Le Width
    _ -> EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    LM_CMP_Fle

        MO_F_Add  Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_FAdd
        MO_F_Sub  Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_FSub
        MO_F_Mul  Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_FMul
        MO_F_Quot Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_FDiv

        MO_And Width
    _   -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_And
        MO_Or  Width
    _   -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_Or
        MO_Xor Width
    _   -> LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    LM_MO_Xor
        MO_Shl Width
    _   -> LlvmMachOp -> LlvmM ExprData
    genBinCastYMach LlvmMachOp
    LM_MO_Shl
        MO_U_Shr Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinCastYMach LlvmMachOp
    LM_MO_LShr
        MO_S_Shr Width
    _ -> LlvmMachOp -> LlvmM ExprData
    genBinCastYMach LlvmMachOp
    LM_MO_AShr

        MO_V_Add Int
    l Width
    w   -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)) LlvmMachOp
    LM_MO_Add
        MO_V_Sub Int
    l Width
    w   -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)) LlvmMachOp
    LM_MO_Sub
        MO_V_Mul Int
    l Width
    w   -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)) LlvmMachOp
    LM_MO_Mul

        MO_VS_Quot Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)) LlvmMachOp
    LM_MO_SDiv
        MO_VS_Rem  Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)) LlvmMachOp
    LM_MO_SRem

        MO_VU_Quot Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)) LlvmMachOp
    LM_MO_UDiv
        MO_VU_Rem  Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmInt Width
    w)) LlvmMachOp
    LM_MO_URem

        MO_VF_Add  Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmFloat Width
    w)) LlvmMachOp
    LM_MO_FAdd
        MO_VF_Sub  Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmFloat Width
    w)) LlvmMachOp
    LM_MO_FSub
        MO_VF_Mul  Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmFloat Width
    w)) LlvmMachOp
    LM_MO_FMul
        MO_VF_Quot Int
    l Width
    w -> LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach (Int -> LlvmType -> LlvmType
    LMVector Int
    l (Width -> LlvmType
    widthToLlvmFloat Width
    w)) LlvmMachOp
    LM_MO_FDiv

        MO_Not Width
    _       -> LlvmM ExprData
    panicOp
        MO_S_Neg Width
    _     -> LlvmM ExprData
    panicOp
        MO_F_Neg Width
    _     -> LlvmM ExprData
    panicOp

        MO_SF_Conv Width
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_FS_Conv Width
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_SS_Conv Width
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_UU_Conv Width
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_XX_Conv Width
    _ Width
    _ -> LlvmM ExprData
    panicOp
        MO_FF_Conv Width
    _ Width
    _ -> LlvmM ExprData
    panicOp

        MO_V_Insert  {} -> LlvmM ExprData
    panicOp

        MO_VS_Neg {} -> LlvmM ExprData
    panicOp

        MO_VF_Insert  {} -> LlvmM ExprData
    panicOp

        MO_VF_Neg {} -> LlvmM ExprData
    panicOp

        MO_AlignmentCheck {} -> LlvmM ExprData
    panicOp

    #if __GLASGOW_HASKELL__ < 811
        MO_VF_Extract {} -> panicOp
        MO_V_Extract {} -> panicOp
    #endif

        where
            binLlvmOp :: (LlvmVar -> LlvmType)
    -> (LlvmVar -> LlvmVar -> LlvmExpression) -> Bool -> LlvmM ExprData
    binLlvmOp LlvmVar -> LlvmType
    ty LlvmVar -> LlvmVar -> LlvmExpression
    binOp Bool
    allow_y_cast = do
              Platform
    platform <- LlvmM Platform
    getPlatform
              WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
                LlvmVar
    vx <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    x
                LlvmVar
    vy <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    y

                if | LlvmVar -> LlvmType
    getVarType LlvmVar
    vx forall a. Eq a => a -> a -> Bool
    == LlvmVar -> LlvmType
    getVarType LlvmVar
    vy
                   -> LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (LlvmVar -> LlvmType
    ty LlvmVar
    vx) forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmExpression
    binOp LlvmVar
    vx LlvmVar
    vy

                   | Bool
    allow_y_cast
                   -> do
                        LlvmVar
    vy' <- forall a. String -> [a] -> a
    singletonPanic String
    "binLlvmOp cast"forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed [(LlvmVar
    vy, (LlvmVar -> LlvmType
    ty LlvmVar
    vx))]
                        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (LlvmVar -> LlvmType
    ty LlvmVar
    vx) forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmExpression
    binOp LlvmVar
    vx LlvmVar
    vy'

                   | Bool
    otherwise
                   -> do
                        -- Error. Continue anyway so we can debug the generated ll file.
                        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                        let style :: PprStyle
    style = LabelStyle -> PprStyle
    PprCode LabelStyle
    CStyle
                            toString :: SDoc -> String
    toString SDoc
    doc = SDocContext -> SDoc -> String
    renderWithContext (DynFlags -> PprStyle -> SDocContext
    initSDocContext DynFlags
    dflags PprStyle
    style) SDoc
    doc
                            cmmToStr :: CmmExpr -> [String]
    cmmToStr = (String -> [String]
    lines forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> String
    toString forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> CmmExpr -> SDoc
    PprCmm.pprExpr Platform
    platform)
                        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ [LMString] -> LlvmStatement
    Comment forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ CmmExpr -> [String]
    cmmToStr CmmExpr
    x
                        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement forall a b. (a -> b) -> a -> b
    $ [LMString] -> LlvmStatement
    Comment forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map String -> LMString
    fsLit forall a b. (a -> b) -> a -> b
    $ CmmExpr -> [String]
    cmmToStr CmmExpr
    y
                        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (LlvmVar -> LlvmType
    ty LlvmVar
    vx) forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmExpression
    binOp LlvmVar
    vx LlvmVar
    vy

            binCastLlvmOp :: LlvmType
    -> (LlvmVar -> LlvmVar -> LlvmExpression) -> LlvmM ExprData
    binCastLlvmOp LlvmType
    ty LlvmVar -> LlvmVar -> LlvmExpression
    binOp = WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
                LlvmVar
    vx <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    x
                LlvmVar
    vy <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    y
                [LlvmVar]
    vxy' <- Signage
    -> [(LlvmVar, LlvmType)] -> WriterT LlvmAccum LlvmM [LlvmVar]
    castVarsW Signage
    Signed [(LlvmVar
    vx, LlvmType
    ty), (LlvmVar
    vy, LlvmType
    ty)]
                case [LlvmVar]
    vxy' of
                  [LlvmVar
    vx',LlvmVar
    vy'] -> LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmVar -> LlvmExpression
    binOp LlvmVar
    vx' LlvmVar
    vy'
                  [LlvmVar]
    _         -> forall a. HasCallStack => String -> a
    panic String
    "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 :: EOption -> LlvmCmpOp -> LlvmM ExprData
    genBinComp EOption
    opt LlvmCmpOp
    cmp = do
                ed :: ExprData
    ed@(LlvmVar
    v1, LlvmStatements
    stmts, [LlvmCmmDecl]
    top) <- (LlvmVar -> LlvmType)
    -> (LlvmVar -> LlvmVar -> LlvmExpression) -> Bool -> LlvmM ExprData
    binLlvmOp (\LlvmVar
    _ -> LlvmType
    i1) (LlvmCmpOp -> LlvmVar -> LlvmVar -> LlvmExpression
    Compare LlvmCmpOp
    cmp) Bool
    False
                DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                Platform
    platform <- LlvmM Platform
    getPlatform
                if LlvmVar -> LlvmType
    getVarType LlvmVar
    v1 forall a. Eq a => a -> a -> Bool
    == LlvmType
    i1
                    then case EOption -> Bool
    i1Expected EOption
    opt of
                        Bool
    True  -> forall (m :: * -> *) a. Monad m => a -> m a
    return ExprData
    ed
                        Bool
    False -> do
                            let w_ :: LlvmType
    w_ = Platform -> LlvmType
    llvmWord Platform
    platform
                            (LlvmVar
    v2, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    w_ forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Zext LlvmVar
    v1 LlvmType
    w_
                            forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v2, LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    top)
                    else
                        forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "genBinComp: Compare returned type other then i1! "
                            forall a. [a] -> [a] -> [a]
    ++ (DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags forall a b. (a -> b) -> a -> b
    $ forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    v1)

            genBinMach :: LlvmMachOp -> LlvmM ExprData
    genBinMach LlvmMachOp
    op = (LlvmVar -> LlvmType)
    -> (LlvmVar -> LlvmVar -> LlvmExpression) -> Bool -> LlvmM ExprData
    binLlvmOp LlvmVar -> LlvmType
    getVarType (LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    op) Bool
    False

            genBinCastYMach :: LlvmMachOp -> LlvmM ExprData
    genBinCastYMach LlvmMachOp
    op = (LlvmVar -> LlvmType)
    -> (LlvmVar -> LlvmVar -> LlvmExpression) -> Bool -> LlvmM ExprData
    binLlvmOp LlvmVar -> LlvmType
    getVarType (LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    op) Bool
    True

            genCastBinMach :: LlvmType -> LlvmMachOp -> LlvmM ExprData
    genCastBinMach LlvmType
    ty LlvmMachOp
    op = LlvmType
    -> (LlvmVar -> LlvmVar -> LlvmExpression) -> LlvmM ExprData
    binCastLlvmOp LlvmType
    ty (LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    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 :: Width -> CmmExpr -> CmmExpr -> LlvmM ExprData
    isSMulOK Width
    _ CmmExpr
    x CmmExpr
    y = do
              Platform
    platform <- LlvmM Platform
    getPlatform
              DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
              WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
                LlvmVar
    vx <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    x
                LlvmVar
    vy <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    y

                let word :: LlvmType
    word  = LlvmVar -> LlvmType
    getVarType LlvmVar
    vx
                let word2 :: LlvmType
    word2 = Int -> LlvmType
    LMInt forall a b. (a -> b) -> a -> b
    $ Int
    2 forall a. Num a => a -> a -> a
    * (Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    vx)
                let shift :: Int
    shift = Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    word
                let shift1 :: LlvmVar
    shift1 = forall a. Integral a => Platform -> a -> LlvmVar
    toIWord Platform
    platform (Int
    shift forall a. Num a => a -> a -> a
    - Int
    1)
                let shift2 :: LlvmVar
    shift2 = forall a. Integral a => Platform -> a -> LlvmVar
    toIWord Platform
    platform Int
    shift

                if LlvmType -> Bool
    isInt LlvmType
    word
                    then do
                        LlvmVar
    x1     <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word2 forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Sext LlvmVar
    vx LlvmType
    word2
                        LlvmVar
    y1     <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word2 forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Sext LlvmVar
    vy LlvmType
    word2
                        LlvmVar
    r1     <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word2 forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Mul LlvmVar
    x1 LlvmVar
    y1
                        LlvmVar
    rlow1  <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    r1 LlvmType
    word
                        LlvmVar
    rlow2  <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_AShr LlvmVar
    rlow1 LlvmVar
    shift1
                        LlvmVar
    rhigh1 <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word2 forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_AShr LlvmVar
    r1 LlvmVar
    shift2
                        LlvmVar
    rhigh2 <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    rhigh1 LlvmType
    word
                        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    word forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Sub LlvmVar
    rlow2 LlvmVar
    rhigh2

                    else
                        forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "isSMulOK: Not bit type! (" forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr LlvmType
    word) forall a. [a] -> [a] -> [a]
    ++ String
    ")"

            panicOp :: LlvmM ExprData
    panicOp = forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "LLVM.CodeGen.genMachOp_slow: unary op encountered"
                           forall a. [a] -> [a] -> [a]
    ++ String
    "with two arguments! (" forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show MachOp
    op forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    -- More than two expression, invalid!
    genMachOp_slow EOption
    _ MachOp
    _ [CmmExpr]
    _ = forall a. HasCallStack => String -> a
    panic String
    "genMachOp: More than 2 expressions in MachOp!"

    -- | Handle CmmLoad expression.
    genLoad :: Atomic -> CmmExpr -> CmmType -> AlignmentSpec -> 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 :: Bool -> CmmExpr -> CmmType -> AlignmentSpec -> LlvmM ExprData
    genLoad Bool
    atomic e :: CmmExpr
    e@(CmmReg (CmmGlobal GlobalReg
    r)) CmmType
    ty AlignmentSpec
    align
        = Bool
    -> CmmExpr
    -> GlobalReg
    -> Int
    -> CmmType
    -> AlignmentSpec
    -> LlvmM ExprData
    genLoad_fast Bool
    atomic CmmExpr
    e GlobalReg
    r Int
    0 CmmType
    ty AlignmentSpec
    align

    genLoad Bool
    atomic e :: CmmExpr
    e@(CmmRegOff (CmmGlobal GlobalReg
    r) Int
    n) CmmType
    ty AlignmentSpec
    align
        = Bool
    -> CmmExpr
    -> GlobalReg
    -> Int
    -> CmmType
    -> AlignmentSpec
    -> LlvmM ExprData
    genLoad_fast Bool
    atomic CmmExpr
    e GlobalReg
    r Int
    n CmmType
    ty AlignmentSpec
    align

    genLoad Bool
    atomic e :: CmmExpr
    e@(CmmMachOp (MO_Add Width
    _) [
                                (CmmReg (CmmGlobal GlobalReg
    r)),
                                (CmmLit (CmmInt Integer
    n Width
    _))])
                    CmmType
    ty AlignmentSpec
    align
        = Bool
    -> CmmExpr
    -> GlobalReg
    -> Int
    -> CmmType
    -> AlignmentSpec
    -> LlvmM ExprData
    genLoad_fast Bool
    atomic CmmExpr
    e GlobalReg
    r (forall a. Num a => Integer -> a
    fromInteger Integer
    n) CmmType
    ty AlignmentSpec
    align

    genLoad Bool
    atomic e :: CmmExpr
    e@(CmmMachOp (MO_Sub Width
    _) [
                                (CmmReg (CmmGlobal GlobalReg
    r)),
                                (CmmLit (CmmInt Integer
    n Width
    _))])
                    CmmType
    ty AlignmentSpec
    align
        = Bool
    -> CmmExpr
    -> GlobalReg
    -> Int
    -> CmmType
    -> AlignmentSpec
    -> LlvmM ExprData
    genLoad_fast Bool
    atomic CmmExpr
    e GlobalReg
    r (forall a. Num a => a -> a
    negate forall a b. (a -> b) -> a -> b
    $ forall a. Num a => Integer -> a
    fromInteger Integer
    n) CmmType
    ty AlignmentSpec
    align

    -- generic case
    genLoad Bool
    atomic CmmExpr
    e CmmType
    ty AlignmentSpec
    align
        = Unique -> LlvmM [MetaAnnot]
    getTBAAMeta Unique
    topN forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool
    -> CmmExpr
    -> CmmType
    -> AlignmentSpec
    -> [MetaAnnot]
    -> LlvmM ExprData
    genLoad_slow Bool
    atomic CmmExpr
    e CmmType
    ty AlignmentSpec
    align

    -- | 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
                 -> AlignmentSpec -> LlvmM ExprData
    genLoad_fast :: Bool
    -> CmmExpr
    -> GlobalReg
    -> Int
    -> CmmType
    -> AlignmentSpec
    -> LlvmM ExprData
    genLoad_fast Bool
    atomic CmmExpr
    e GlobalReg
    r Int
    n CmmType
    ty AlignmentSpec
    align = do
        Platform
    platform <- LlvmM Platform
    getPlatform
        (LlvmVar
    gv, LlvmType
    grt, LlvmStatements
    s1) <- CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
    getCmmRegVal (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    r)
        [MetaAnnot]
    meta          <- GlobalReg -> LlvmM [MetaAnnot]
    getTBAARegMeta GlobalReg
    r
        let ty' :: LlvmType
    ty'      = CmmType -> LlvmType
    cmmToLlvmType CmmType
    ty
            (Int
    ix,Int
    rem) = Int
    n forall a. Integral a => a -> a -> (a, a)
    `divMod` ((Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmType -> LlvmType
    pLower) LlvmType
    grt  forall a. Integral a => a -> a -> a
    `div` Int
    8)
        case LlvmType -> Bool
    isPointer LlvmType
    grt Bool -> Bool -> Bool
    && Int
    rem forall a. Eq a => a -> a -> Bool
    == Int
    0 of
                Bool
    True  -> do
                    (LlvmVar
    ptr, LlvmStatement
    s2) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    grt forall a b. (a -> b) -> a -> b
    $ Bool -> LlvmVar -> [LlvmVar] -> LlvmExpression
    GetElemPtr Bool
    True LlvmVar
    gv [forall a. Integral a => a -> LlvmVar
    toI32 Int
    ix]
                    -- We might need a different pointer type, so check
                    case LlvmType
    grt forall a. Eq a => a -> a -> Bool
    == LlvmType
    ty' of
                         -- were fine
                         Bool
    True -> do
                             (LlvmVar
    var, LlvmStatement
    s3) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty' ([MetaAnnot] -> LlvmExpression -> LlvmExpression
    MExpr [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ Bool -> LlvmVar -> AlignmentSpec -> LlvmExpression
    mkLoad Bool
    atomic LlvmVar
    ptr AlignmentSpec
    align)
                             forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    var, LlvmStatements
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s3,
                                         [])

                         -- cast to pointer type needed
                         Bool
    False -> do
                             let pty :: LlvmType
    pty = LlvmType -> LlvmType
    pLift LlvmType
    ty'
                             (LlvmVar
    ptr', LlvmStatement
    s3) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    pty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Bitcast LlvmVar
    ptr LlvmType
    pty
                             (LlvmVar
    var, LlvmStatement
    s4) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty' ([MetaAnnot] -> LlvmExpression -> LlvmExpression
    MExpr [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ Bool -> LlvmVar -> AlignmentSpec -> LlvmExpression
    mkLoad Bool
    atomic LlvmVar
    ptr' AlignmentSpec
    align)
                             forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    var, LlvmStatements
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s3
                                        forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s4, [])

                -- If its a bit type then we use the slow method since
                -- we can't avoid casting anyway.
                Bool
    False -> Bool
    -> CmmExpr
    -> CmmType
    -> AlignmentSpec
    -> [MetaAnnot]
    -> LlvmM ExprData
    genLoad_slow Bool
    atomic  CmmExpr
    e CmmType
    ty AlignmentSpec
    align [MetaAnnot]
    meta

    -- | Handle Cmm load expression.
    -- Generic case. Uses casts and pointer arithmetic if needed.
    genLoad_slow :: Atomic -> CmmExpr -> CmmType -> AlignmentSpec -> [MetaAnnot]
                 -> LlvmM ExprData
    genLoad_slow :: Bool
    -> CmmExpr
    -> CmmType
    -> AlignmentSpec
    -> [MetaAnnot]
    -> LlvmM ExprData
    genLoad_slow Bool
    atomic CmmExpr
    e CmmType
    ty AlignmentSpec
    align [MetaAnnot]
    meta = do
      Platform
    platform <- LlvmM Platform
    getPlatform
      DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
      WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData forall a b. (a -> b) -> a -> b
    $ do
        LlvmVar
    iptr <- CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW CmmExpr
    e
        case LlvmVar -> LlvmType
    getVarType LlvmVar
    iptr of
            LMPointer LlvmType
    _ ->
                        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (CmmType -> LlvmType
    cmmToLlvmType CmmType
    ty) ([MetaAnnot] -> LlvmExpression -> LlvmExpression
    MExpr [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ Bool -> LlvmVar -> AlignmentSpec -> LlvmExpression
    mkLoad Bool
    atomic LlvmVar
    iptr AlignmentSpec
    align)

            i :: LlvmType
    i@(LMInt Int
    _) | LlvmType
    i forall a. Eq a => a -> a -> Bool
    == Platform -> LlvmType
    llvmWord Platform
    platform -> do
                        let pty :: LlvmType
    pty = LlvmType -> LlvmType
    LMPointer forall a b. (a -> b) -> a -> b
    $ CmmType -> LlvmType
    cmmToLlvmType CmmType
    ty
                        LlvmVar
    ptr <- LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    pty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Inttoptr LlvmVar
    iptr LlvmType
    pty
                        LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW (CmmType -> LlvmType
    cmmToLlvmType CmmType
    ty) ([MetaAnnot] -> LlvmExpression -> LlvmExpression
    MExpr [MetaAnnot]
    meta forall a b. (a -> b) -> a -> b
    $ Bool -> LlvmVar -> AlignmentSpec -> LlvmExpression
    mkLoad Bool
    atomic LlvmVar
    ptr AlignmentSpec
    align)

            LlvmType
    other -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "exprToVar: CmmLoad expression is not right type!"
                         (Platform -> CmmExpr -> SDoc
    PprCmm.pprExpr Platform
    platform CmmExpr
    e SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text (
                             String
    "Size of Ptr: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (Platform -> Int
    llvmPtrBits Platform
    platform) forall a. [a] -> [a] -> [a]
    ++
                             String
    ", Size of var: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show (Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    other) forall a. [a] -> [a] -> [a]
    ++
                             String
    ", Var: " forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (LlvmOpts -> LlvmVar -> SDoc
    ppVar LlvmOpts
    opts LlvmVar
    iptr)))

    {-
    Note [Alignment of vector-typed values]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    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.
    -}

    mkLoad :: Atomic -> LlvmVar -> AlignmentSpec -> LlvmExpression
    mkLoad :: Bool -> LlvmVar -> AlignmentSpec -> LlvmExpression
    mkLoad Bool
    atomic LlvmVar
    vptr AlignmentSpec
    alignment
      | Bool
    atomic      = LlvmSyncOrdering -> Bool -> LlvmVar -> LlvmExpression
    ALoad LlvmSyncOrdering
    SyncSeqCst Bool
    False LlvmVar
    vptr
      | Bool
    otherwise   = LlvmVar -> LMAlign -> LlvmExpression
    Load LlvmVar
    vptr LMAlign
    align
      where
        ty :: LlvmType
    ty = LlvmType -> LlvmType
    pLower (LlvmVar -> LlvmType
    getVarType LlvmVar
    vptr)
        align :: LMAlign
    align = case AlignmentSpec
    alignment of
                  -- See Note [Alignment of vector-typed values]
                  AlignmentSpec
    _ | LlvmType -> Bool
    isVector LlvmType
    ty  -> forall a. a -> Maybe a
    Just Int
    1
                  AlignmentSpec
    Unaligned        -> forall a. a -> Maybe a
    Just Int
    1
                  AlignmentSpec
    NaturallyAligned -> forall a. Maybe a
    Nothing

    -- | 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 :: CmmReg -> LlvmM LlvmVar
    getCmmReg (CmmLocal (LocalReg Unique
    un CmmType
    _))
      = do Maybe LlvmType
    exists <- forall key. Uniquable key => key -> LlvmM (Maybe LlvmType)
    varLookup Unique
    un
           DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           case Maybe LlvmType
    exists of
             Just LlvmType
    ety -> forall (m :: * -> *) a. Monad m => a -> m a
    return (Unique -> LlvmType -> LlvmVar
    LMLocalVar Unique
    un forall a b. (a -> b) -> a -> b
    $ LlvmType -> LlvmType
    pLift LlvmType
    ety)
             Maybe LlvmType
    Nothing  -> forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "getCmmReg: Cmm register " forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr Unique
    un) forall a. [a] -> [a] -> [a]
    ++ String
    " 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 GlobalReg
    g)
      = do Bool
    onStack <- GlobalReg -> LlvmM Bool
    checkStackReg GlobalReg
    g
           DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           Platform
    platform <- LlvmM Platform
    getPlatform
           if Bool
    onStack
             then forall (m :: * -> *) a. Monad m => a -> m a
    return (Platform -> GlobalReg -> LlvmVar
    lmGlobalRegVar Platform
    platform GlobalReg
    g)
             else forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "getCmmReg: Cmm register " forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall a. Outputable a => a -> SDoc
    ppr GlobalReg
    g) forall a. [a] -> [a] -> [a]
    ++ String
    " 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 :: CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
    getCmmRegVal CmmReg
    reg =
      case CmmReg
    reg of
        CmmGlobal GlobalReg
    g -> do
          Bool
    onStack <- GlobalReg -> LlvmM Bool
    checkStackReg GlobalReg
    g
          Platform
    platform <- LlvmM Platform
    getPlatform
          if Bool
    onStack then LlvmM (LlvmVar, LlvmType, LlvmStatements)
    loadFromStack else do
            let r :: LlvmVar
    r = Platform -> GlobalReg -> LlvmVar
    lmGlobalRegArg Platform
    platform GlobalReg
    g
            forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    r, LlvmVar -> LlvmType
    getVarType LlvmVar
    r, forall a. OrdList a
    nilOL)
        CmmReg
    _ -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
    loadFromStack
     where loadFromStack :: LlvmM (LlvmVar, LlvmType, LlvmStatements)
    loadFromStack = do
             LlvmVar
    ptr <- CmmReg -> LlvmM LlvmVar
    getCmmReg CmmReg
    reg
             let ty :: LlvmType
    ty = LlvmType -> LlvmType
    pLower forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    ptr
             (LlvmVar
    v, LlvmStatement
    s) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty (LlvmVar -> LMAlign -> LlvmExpression
    Load LlvmVar
    ptr forall a. Maybe a
    Nothing)
             forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v, LlvmType
    ty, forall a. a -> OrdList a
    unitOL LlvmStatement
    s)

    -- | Allocate a local CmmReg on the stack
    allocReg :: CmmReg -> (LlvmVar, LlvmStatements)
    allocReg :: CmmReg -> (LlvmVar, LlvmStatements)
    allocReg (CmmLocal (LocalReg Unique
    un CmmType
    ty))
      = let ty' :: LlvmType
    ty' = CmmType -> LlvmType
    cmmToLlvmType CmmType
    ty
            var :: LlvmVar
    var = Unique -> LlvmType -> LlvmVar
    LMLocalVar Unique
    un (LlvmType -> LlvmType
    LMPointer LlvmType
    ty')
            alc :: LlvmExpression
    alc = LlvmType -> Int -> LlvmExpression
    Alloca LlvmType
    ty' Int
    1
        in (LlvmVar
    var, forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmExpression -> LlvmStatement
    Assignment LlvmVar
    var LlvmExpression
    alc)

    allocReg CmmReg
    _ = forall a. HasCallStack => String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "allocReg: Global reg encountered! Global registers should"
                        forall a. [a] -> [a] -> [a]
    ++ String
    " have been handled elsewhere!"

    -- | Generate code for a literal
    genLit :: EOption -> CmmLit -> LlvmM ExprData
    genLit :: EOption -> CmmLit -> LlvmM ExprData
    genLit EOption
    opt (CmmInt Integer
    i Width
    w)
      -- See Note [Literals and branch conditions].
      = let width :: LlvmType
    width | EOption -> Bool
    i1Expected EOption
    opt = LlvmType
    i1
                  | Bool
    otherwise      = Int -> LlvmType
    LMInt (Width -> Int
    widthInBits Width
    w)
            -- comm  = Comment [ fsLit $ "EOption: " ++ show opt
            --                 , fsLit $ "Width  : " ++ show w
            --                 , fsLit $ "Width' : " ++ show (widthInBits w)
            --                 ]
        in forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    width Integer
    i, forall a. OrdList a
    nilOL, [])

    genLit EOption
    _ (CmmFloat Rational
    r Width
    w)
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Double -> LlvmType -> LlvmLit
    LMFloatLit (forall a. Fractional a => Rational -> a
    fromRational Rational
    r) (Width -> LlvmType
    widthToLlvmFloat Width
    w),
                  forall a. OrdList a
    nilOL, [])

    genLit EOption
    opt (CmmVec [CmmLit]
    ls)
      = do [LlvmLit]
    llvmLits <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM CmmLit -> LlvmM LlvmLit
    toLlvmLit [CmmLit]
    ls
           forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ [LlvmLit] -> LlvmLit
    LMVectorLit [LlvmLit]
    llvmLits, forall a. OrdList a
    nilOL, [])
      where
        toLlvmLit :: CmmLit -> LlvmM LlvmLit
        toLlvmLit :: CmmLit -> LlvmM LlvmLit
    toLlvmLit CmmLit
    lit = do
            (LlvmVar
    llvmLitVar, LlvmStatements
    _, [LlvmCmmDecl]
    _) <- EOption -> CmmLit -> LlvmM ExprData
    genLit EOption
    opt CmmLit
    lit
            case LlvmVar
    llvmLitVar of
              LMLitVar LlvmLit
    llvmLit -> forall (m :: * -> *) a. Monad m => a -> m a
    return LlvmLit
    llvmLit
              LlvmVar
    _ -> forall a. HasCallStack => String -> a
    panic String
    "genLit"

    genLit EOption
    _ cmm :: CmmLit
    cmm@(CmmLabel CLabel
    l)
      = do LlvmVar
    var <- LMString -> LlvmM LlvmVar
    getGlobalPtr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    l
           Platform
    platform <- LlvmM Platform
    getPlatform
           let lmty :: LlvmType
    lmty = CmmType -> LlvmType
    cmmToLlvmType forall a b. (a -> b) -> a -> b
    $ Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    cmm
           (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    lmty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Ptrtoint LlvmVar
    var (Platform -> LlvmType
    llvmWord Platform
    platform)
           forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v1, forall a. a -> OrdList a
    unitOL LlvmStatement
    s1, [])

    genLit EOption
    opt (CmmLabelOff CLabel
    label Int
    off) = do
        Platform
    platform <- LlvmM Platform
    getPlatform
        (LlvmVar
    vlbl, LlvmStatements
    stmts, [LlvmCmmDecl]
    stat) <- EOption -> CmmLit -> LlvmM ExprData
    genLit EOption
    opt (CLabel -> CmmLit
    CmmLabel CLabel
    label)
        let voff :: LlvmVar
    voff = forall a. Integral a => Platform -> a -> LlvmVar
    toIWord Platform
    platform Int
    off
        (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (LlvmVar -> LlvmType
    getVarType LlvmVar
    vlbl) forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Add LlvmVar
    vlbl LlvmVar
    voff
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v1, LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1, [LlvmCmmDecl]
    stat)

    genLit EOption
    opt (CmmLabelDiffOff CLabel
    l1 CLabel
    l2 Int
    off Width
    w) = do
        Platform
    platform <- LlvmM Platform
    getPlatform
        (LlvmVar
    vl1, LlvmStatements
    stmts1, [LlvmCmmDecl]
    stat1) <- EOption -> CmmLit -> LlvmM ExprData
    genLit EOption
    opt (CLabel -> CmmLit
    CmmLabel CLabel
    l1)
        (LlvmVar
    vl2, LlvmStatements
    stmts2, [LlvmCmmDecl]
    stat2) <- EOption -> CmmLit -> LlvmM ExprData
    genLit EOption
    opt (CLabel -> CmmLit
    CmmLabel CLabel
    l2)
        let voff :: LlvmVar
    voff = forall a. Integral a => Platform -> a -> LlvmVar
    toIWord Platform
    platform Int
    off
        let ty1 :: LlvmType
    ty1 = LlvmVar -> LlvmType
    getVarType LlvmVar
    vl1
        let ty2 :: LlvmType
    ty2 = LlvmVar -> LlvmType
    getVarType LlvmVar
    vl2
        if (LlvmType -> Bool
    isInt LlvmType
    ty1) Bool -> Bool -> Bool
    && (LlvmType -> Bool
    isInt LlvmType
    ty2)
           Bool -> Bool -> Bool
    && (Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    ty1 forall a. Eq a => a -> a -> Bool
    == Platform -> LlvmType -> Int
    llvmWidthInBits Platform
    platform LlvmType
    ty2)
           then do
                (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (LlvmVar -> LlvmType
    getVarType LlvmVar
    vl1) forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Sub LlvmVar
    vl1 LlvmVar
    vl2
                (LlvmVar
    v2, LlvmStatement
    s2) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (LlvmVar -> LlvmType
    getVarType LlvmVar
    v1 ) forall a b. (a -> b) -> a -> b
    $ LlvmMachOp -> LlvmVar -> LlvmVar -> LlvmExpression
    LlvmOp LlvmMachOp
    LM_MO_Add LlvmVar
    v1 LlvmVar
    voff
                let ty :: LlvmType
    ty = Width -> LlvmType
    widthToLlvmInt Width
    w
                let stmts :: LlvmStatements
    stmts = LlvmStatements
    stmts1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` LlvmStatements
    stmts2 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s1 forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s2
                if Width
    w forall a. Eq a => a -> a -> Bool
    /= Platform -> Width
    wordWidth Platform
    platform
                  then do
                    (LlvmVar
    v3, LlvmStatement
    s3) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Trunc LlvmVar
    v2 LlvmType
    ty
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v3, LlvmStatements
    stmts forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    s3, [LlvmCmmDecl]
    stat1 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    stat2)
                  else
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v2, LlvmStatements
    stmts, [LlvmCmmDecl]
    stat1 forall a. [a] -> [a] -> [a]
    ++ [LlvmCmmDecl]
    stat2)
            else
                forall a. HasCallStack => String -> a
    panic String
    "genLit: CmmLabelDiffOff encountered with different label ty!"

    genLit EOption
    opt (CmmBlock BlockId
    b)
      = EOption -> CmmLit -> LlvmM ExprData
    genLit EOption
    opt (CLabel -> CmmLit
    CmmLabel forall a b. (a -> b) -> a -> b
    $ BlockId -> CLabel
    infoTblLbl BlockId
    b)

    genLit EOption
    _ CmmLit
    CmmHighStackMark
      = forall a. HasCallStack => String -> a
    panic String
    "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 :: [GlobalReg] -> [CmmBlock] -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    funPrologue [GlobalReg]
    live [CmmBlock]
    cmmBlocks = do

      let getAssignedRegs :: CmmNode O O -> [CmmReg]
          getAssignedRegs :: CmmNode O O -> [CmmReg]
    getAssignedRegs (CmmAssign CmmReg
    reg CmmExpr
    _)  = [CmmReg
    reg]
          getAssignedRegs (CmmUnsafeForeignCall ForeignTarget
    _ [CmmFormal]
    rs [CmmExpr]
    _) = forall a b. (a -> b) -> [a] -> [b]
    map CmmFormal -> CmmReg
    CmmLocal [CmmFormal]
    rs
          getAssignedRegs CmmNode O O
    _                  = []
          getRegsBlock :: (a, Block CmmNode O O, c) -> [CmmReg]
    getRegsBlock (a
    _, Block CmmNode O O
    body, c
    _)          = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap CmmNode O O -> [CmmReg]
    getAssignedRegs forall a b. (a -> b) -> a -> b
    $ forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    body
          assignedRegs :: [CmmReg]
    assignedRegs = forall a. Eq a => [a] -> [a]
    nub forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (forall {a} {c}. (a, Block CmmNode O O, c) -> [CmmReg]
    getRegsBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit) [CmmBlock]
    cmmBlocks
          isLive :: GlobalReg -> Bool
    isLive GlobalReg
    r     = GlobalReg
    r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [GlobalReg]
    alwaysLive Bool -> Bool -> Bool
    || GlobalReg
    r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [GlobalReg]
    live

      Platform
    platform <- LlvmM Platform
    getPlatform
      [LlvmStatements]
    stmtss <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [CmmReg]
    assignedRegs forall a b. (a -> b) -> a -> b
    $ \CmmReg
    reg ->
        case CmmReg
    reg of
          CmmLocal (LocalReg Unique
    un CmmType
    _) -> do
            let (LlvmVar
    newv, LlvmStatements
    stmts) = CmmReg -> (LlvmVar, LlvmStatements)
    allocReg CmmReg
    reg
            forall key. Uniquable key => key -> LlvmType -> LlvmM ()
    varInsert Unique
    un (LlvmType -> LlvmType
    pLower forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    newv)
            forall (m :: * -> *) a. Monad m => a -> m a
    return LlvmStatements
    stmts
          CmmGlobal GlobalReg
    r -> do
            let reg :: LlvmVar
    reg   = Platform -> GlobalReg -> LlvmVar
    lmGlobalRegVar Platform
    platform GlobalReg
    r
                arg :: LlvmVar
    arg   = Platform -> GlobalReg -> LlvmVar
    lmGlobalRegArg Platform
    platform GlobalReg
    r
                ty :: LlvmType
    ty    = (LlvmType -> LlvmType
    pLower forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmVar -> LlvmType
    getVarType) LlvmVar
    reg
                trash :: LlvmVar
    trash = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ LlvmType -> LlvmLit
    LMUndefLit LlvmType
    ty
                rval :: LlvmVar
    rval  = if GlobalReg -> Bool
    isLive GlobalReg
    r then LlvmVar
    arg else LlvmVar
    trash
                alloc :: LlvmStatement
    alloc = LlvmVar -> LlvmExpression -> LlvmStatement
    Assignment LlvmVar
    reg forall a b. (a -> b) -> a -> b
    $ LlvmType -> Int -> LlvmExpression
    Alloca (LlvmType -> LlvmType
    pLower forall a b. (a -> b) -> a -> b
    $ LlvmVar -> LlvmType
    getVarType LlvmVar
    reg) Int
    1
            GlobalReg -> LlvmM ()
    markStackReg GlobalReg
    r
            forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. [a] -> OrdList a
    toOL [LlvmStatement
    alloc, LlvmVar -> LlvmVar -> LMAlign -> LlvmStatement
    Store LlvmVar
    rval LlvmVar
    reg forall a. Maybe a
    Nothing]

      forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. [OrdList a] -> OrdList a
    concatOL [LlvmStatements]
    stmtss forall a. OrdList a -> a -> OrdList a
    `snocOL` LlvmStatement
    jumpToEntry, [])
      where
        CmmBlock
    entryBlk : [CmmBlock]
    _ = [CmmBlock]
    cmmBlocks
        jumpToEntry :: LlvmStatement
    jumpToEntry = LlvmVar -> LlvmStatement
    Branch forall a b. (a -> b) -> a -> b
    $ BlockId -> LlvmVar
    blockIdToLlvm (forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    entryBlk)

    -- | Function epilogue. Load STG variables to use as argument for call.
    -- STG Liveness optimisation done here.
    funEpilogue :: LiveGlobalRegs -> LlvmM ([LlvmVar], LlvmStatements)
    funEpilogue :: [GlobalReg] -> LlvmM ([LlvmVar], LlvmStatements)
    funEpilogue [GlobalReg]
    live = do
        Platform
    platform <- LlvmM Platform
    getPlatform

        let paddingRegs :: [GlobalReg]
    paddingRegs = Platform -> [GlobalReg] -> [GlobalReg]
    padLiveArgs Platform
    platform [GlobalReg]
    live

        -- Set to value or "undef" depending on whether the register is
        -- actually live
        let loadExpr :: GlobalReg -> LlvmM (Maybe LlvmVar, LlvmStatements)
    loadExpr GlobalReg
    r = do
              (LlvmVar
    v, LlvmType
    _, LlvmStatements
    s) <- CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)
    getCmmRegVal (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    r)
              forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ LlvmVar
    v, LlvmStatements
    s)
            loadUndef :: GlobalReg -> LlvmM (Maybe LlvmVar, LlvmStatements)
    loadUndef GlobalReg
    r = do
              let ty :: LlvmType
    ty = (LlvmType -> LlvmType
    pLower forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmVar -> LlvmType
    getVarType forall a b. (a -> b) -> a -> b
    $ Platform -> GlobalReg -> LlvmVar
    lmGlobalRegVar Platform
    platform GlobalReg
    r)
              forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ LlvmType -> LlvmLit
    LMUndefLit LlvmType
    ty, forall a. OrdList a
    nilOL)

        -- Note that floating-point registers in `activeStgRegs` must be sorted
        -- according to the calling convention.
        --  E.g. for X86:
        --     GOOD: F1,D1,XMM1,F2,D2,XMM2,...
        --     BAD : F1,F2,F3,D1,D2,D3,XMM1,XMM2,XMM3,...
        --  As Fn, Dn and XMMn use the same register (XMMn) to be passed, we don't
        --  want to pass F2 before D1 for example, otherwise we could get F2 -> XMM1
        --  and D1 -> XMM2.
        let allRegs :: [GlobalReg]
    allRegs = Platform -> [GlobalReg]
    activeStgRegs Platform
    platform
        [(Maybe LlvmVar, LlvmStatements)]
    loads <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [GlobalReg]
    allRegs forall a b. (a -> b) -> a -> b
    $ \GlobalReg
    r -> if
          -- load live registers
          | GlobalReg
    r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [GlobalReg]
    alwaysLive  -> GlobalReg -> LlvmM (Maybe LlvmVar, LlvmStatements)
    loadExpr GlobalReg
    r
          | GlobalReg
    r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [GlobalReg]
    live        -> GlobalReg -> LlvmM (Maybe LlvmVar, LlvmStatements)
    loadExpr GlobalReg
    r
          -- load all non Floating-Point Registers
          | Bool -> Bool
    not (GlobalReg -> Bool
    isFPR GlobalReg
    r)        -> GlobalReg -> LlvmM (Maybe LlvmVar, LlvmStatements)
    loadUndef GlobalReg
    r
          -- load padding Floating-Point Registers
          | GlobalReg
    r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [GlobalReg]
    paddingRegs -> GlobalReg -> LlvmM (Maybe LlvmVar, LlvmStatements)
    loadUndef GlobalReg
    r
          | Bool
    otherwise            -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. Maybe a
    Nothing, forall a. OrdList a
    nilOL)

        let ([Maybe LlvmVar]
    vars, [LlvmStatements]
    stmts) = forall a b. [(a, b)] -> ([a], [b])
    unzip [(Maybe LlvmVar, LlvmStatements)]
    loads
        forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. [Maybe a] -> [a]
    catMaybes [Maybe LlvmVar]
    vars, forall a. [OrdList a] -> OrdList a
    concatOL [LlvmStatements]
    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 :: [GlobalReg] -> CLabel -> LlvmM ExprData
    getHsFunc [GlobalReg]
    live CLabel
    lbl
      = do LlvmType
    fty <- [GlobalReg] -> LlvmM LlvmType
    llvmFunTy [GlobalReg]
    live
           LMString
    name <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    lbl
           LMString -> LlvmType -> LlvmM ExprData
    getHsFunc' LMString
    name LlvmType
    fty

    getHsFunc' :: LMString -> LlvmType -> LlvmM ExprData
    getHsFunc' :: LMString -> LlvmType -> LlvmM ExprData
    getHsFunc' LMString
    name LlvmType
    fty
      = do LlvmVar
    fun <- LMString -> LlvmM LlvmVar
    getGlobalPtr LMString
    name
           if LlvmVar -> LlvmType
    getVarType LlvmVar
    fun forall a. Eq a => a -> a -> Bool
    == LlvmType
    fty
             then forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    fun, forall a. OrdList a
    nilOL, [])
             else do (LlvmVar
    v1, LlvmStatement
    s1) <- LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr (LlvmType -> LlvmType
    pLift LlvmType
    fty)
                                   forall a b. (a -> b) -> a -> b
    $ LlvmCastOp -> LlvmVar -> LlvmType -> LlvmExpression
    Cast LlvmCastOp
    LM_Bitcast LlvmVar
    fun (LlvmType -> LlvmType
    pLift LlvmType
    fty)
                     forall (m :: * -> *) a. Monad m => a -> m a
    return  (LlvmVar
    v1, forall a. a -> OrdList a
    unitOL LlvmStatement
    s1, [])

    -- | Create a new local var
    mkLocalVar :: LlvmType -> LlvmM LlvmVar
    mkLocalVar :: LlvmType -> LlvmM LlvmVar
    mkLocalVar LlvmType
    ty = do
        Unique
    un <- forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Unique -> LlvmType -> LlvmVar
    LMLocalVar Unique
    un LlvmType
    ty

    -- | Execute an expression, assigning result to a var
    doExpr :: LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr :: LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    ty LlvmExpression
    expr = do
        LlvmVar
    v <- LlvmType -> LlvmM LlvmVar
    mkLocalVar LlvmType
    ty
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    v, LlvmVar -> LlvmExpression -> LlvmStatement
    Assignment LlvmVar
    v LlvmExpression
    expr)

    -- | Expand CmmRegOff
    expandCmmReg :: Platform -> (CmmReg, Int) -> CmmExpr
    expandCmmReg :: Platform -> (CmmReg, Int) -> CmmExpr
    expandCmmReg Platform
    platform (CmmReg
    reg, Int
    off)
      = let width :: Width
    width = CmmType -> Width
    typeWidth (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg)
            voff :: CmmExpr
    voff  = CmmLit -> CmmExpr
    CmmLit forall a b. (a -> b) -> a -> b
    $ Integer -> Width -> CmmLit
    CmmInt (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    width
        in MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    width) [CmmReg -> CmmExpr
    CmmReg CmmReg
    reg, CmmExpr
    voff]

    -- | Convert a block id into a appropriate Llvm label
    blockIdToLlvm :: BlockId -> LlvmVar
    blockIdToLlvm :: BlockId -> LlvmVar
    blockIdToLlvm BlockId
    bid = Unique -> LlvmType -> LlvmVar
    LMLocalVar (forall a. Uniquable a => a -> Unique
    getUnique BlockId
    bid) LlvmType
    LMLabel

    -- | Create Llvm int Literal
    mkIntLit :: Integral a => LlvmType -> a -> LlvmVar
    mkIntLit :: forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    ty a
    i = LlvmLit -> LlvmVar
    LMLitVar forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a. Integral a => a -> Integer
    toInteger a
    i) LlvmType
    ty

    -- | Convert int type to a LLvmVar of word or i32 size
    toI32 :: Integral a => a -> LlvmVar
    toI32 :: forall a. Integral a => a -> LlvmVar
    toI32 = forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit LlvmType
    i32

    toIWord :: Integral a => Platform -> a -> LlvmVar
    toIWord :: forall a. Integral a => Platform -> a -> LlvmVar
    toIWord Platform
    platform = forall a. Integral a => LlvmType -> a -> LlvmVar
    mkIntLit (Platform -> LlvmType
    llvmWord Platform
    platform)

    -- | Error functions
    panic :: HasCallStack => String -> a
    panic :: forall a. HasCallStack => String -> a
    panic String
    s = forall a. String -> a
    Panic.panic forall a b. (a -> b) -> a -> b
    $ String
    "GHC.CmmToLlvm.CodeGen." forall a. [a] -> [a] -> [a]
    ++ String
    s

    pprPanic :: HasCallStack => String -> SDoc -> a
    pprPanic :: forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    s SDoc
    d = forall a. HasCallStack => String -> SDoc -> a
    Panic.pprPanic (String
    "GHC.CmmToLlvm.CodeGen." forall a. [a] -> [a] -> [a]
    ++ String
    s) SDoc
    d

    -- | Returns TBAA meta data by unique
    getTBAAMeta :: Unique -> LlvmM [MetaAnnot]
    getTBAAMeta :: Unique -> LlvmM [MetaAnnot]
    getTBAAMeta Unique
    u = do
        Maybe MetaId
    mi <- Unique -> LlvmM (Maybe MetaId)
    getUniqMeta Unique
    u
        forall (m :: * -> *) a. Monad m => a -> m a
    return [LMString -> MetaExpr -> MetaAnnot
    MetaAnnot LMString
    tbaa (MetaId -> MetaExpr
    MetaNode MetaId
    i) | let Just MetaId
    i = Maybe MetaId
    mi]

    -- | Returns TBAA meta data for given register
    getTBAARegMeta :: GlobalReg -> LlvmM [MetaAnnot]
    getTBAARegMeta :: GlobalReg -> LlvmM [MetaAnnot]
    getTBAARegMeta = Unique -> LlvmM [MetaAnnot]
    getTBAAMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GlobalReg -> Unique
    getTBAA

    -- | A more convenient way of accumulating LLVM statements and declarations.
    data LlvmAccum = LlvmAccum LlvmStatements [LlvmCmmDecl]

    instance Semigroup LlvmAccum where
      LlvmAccum LlvmStatements
    stmtsA [LlvmCmmDecl]
    declsA <> :: LlvmAccum -> LlvmAccum -> LlvmAccum
    <> LlvmAccum LlvmStatements
    stmtsB [LlvmCmmDecl]
    declsB =
            LlvmStatements -> [LlvmCmmDecl] -> LlvmAccum
    LlvmAccum (LlvmStatements
    stmtsA forall a. Semigroup a => a -> a -> a
    Semigroup.<> LlvmStatements
    stmtsB) ([LlvmCmmDecl]
    declsA forall a. Semigroup a => a -> a -> a
    Semigroup.<> [LlvmCmmDecl]
    declsB)

    instance Monoid LlvmAccum where
        mempty :: LlvmAccum
    mempty = LlvmStatements -> [LlvmCmmDecl] -> LlvmAccum
    LlvmAccum forall a. OrdList a
    nilOL []
        mappend :: LlvmAccum -> LlvmAccum -> LlvmAccum
    mappend = forall a. Semigroup a => a -> a -> a
    (Semigroup.<>)

    liftExprData :: LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
    liftExprData :: LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
    liftExprData LlvmM ExprData
    action = do
        (LlvmVar
    var, LlvmStatements
    stmts, [LlvmCmmDecl]
    decls) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift LlvmM ExprData
    action
        forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    tell forall a b. (a -> b) -> a -> b
    $ LlvmStatements -> [LlvmCmmDecl] -> LlvmAccum
    LlvmAccum LlvmStatements
    stmts [LlvmCmmDecl]
    decls
        forall (m :: * -> *) a. Monad m => a -> m a
    return LlvmVar
    var

    statement :: LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement :: LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement LlvmStatement
    stmt = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    tell forall a b. (a -> b) -> a -> b
    $ LlvmStatements -> [LlvmCmmDecl] -> LlvmAccum
    LlvmAccum (forall a. a -> OrdList a
    unitOL LlvmStatement
    stmt) []

    doExprW :: LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW :: LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar
    doExprW LlvmType
    a LlvmExpression
    b = do
        (LlvmVar
    var, LlvmStatement
    stmt) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)
    doExpr LlvmType
    a LlvmExpression
    b
        LlvmStatement -> WriterT LlvmAccum LlvmM ()
    statement LlvmStatement
    stmt
        forall (m :: * -> *) a. Monad m => a -> m a
    return LlvmVar
    var

    exprToVarW :: CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW :: CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar
    exprToVarW = LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
    liftExprData forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmExpr -> LlvmM ExprData
    exprToVar

    runExprData :: WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData :: WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData
    runExprData WriterT LlvmAccum LlvmM LlvmVar
    action = do
        (LlvmVar
    var, LlvmAccum LlvmStatements
    stmts [LlvmCmmDecl]
    decls) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT WriterT LlvmAccum LlvmM LlvmVar
    action
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmVar
    var, LlvmStatements
    stmts, [LlvmCmmDecl]
    decls)

    runStmtsDecls :: WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls :: WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])
    runStmtsDecls WriterT LlvmAccum LlvmM ()
    action = do
        LlvmAccum LlvmStatements
    stmts [LlvmCmmDecl]
    decls <- forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
    execWriterT WriterT LlvmAccum LlvmM ()
    action
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmStatements
    stmts, [LlvmCmmDecl]
    decls)

    getCmmRegW :: CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW :: CmmReg -> WriterT LlvmAccum LlvmM LlvmVar
    getCmmRegW = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmReg -> LlvmM LlvmVar
    getCmmReg

    genLoadW :: Atomic -> CmmExpr -> CmmType -> AlignmentSpec -> WriterT LlvmAccum LlvmM LlvmVar
    genLoadW :: Bool
    -> CmmExpr
    -> CmmType
    -> AlignmentSpec
    -> WriterT LlvmAccum LlvmM LlvmVar
    genLoadW Bool
    atomic CmmExpr
    e CmmType
    ty AlignmentSpec
    alignment = LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
    liftExprData forall a b. (a -> b) -> a -> b
    $ Bool -> CmmExpr -> CmmType -> AlignmentSpec -> LlvmM ExprData
    genLoad Bool
    atomic CmmExpr
    e CmmType
    ty AlignmentSpec
    alignment

    -- | Return element of single-element list; 'panic' if list is not a single-element list
    singletonPanic :: String -> [a] -> a
    singletonPanic :: forall a. String -> [a] -> a
    singletonPanic String
    _ [a
    x] = a
    x
    singletonPanic String
    s [a]
    _ = forall a. HasCallStack => String -> a
    panic String
    s