    {-# LANGUAGE CPP           #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE GADTs         #-}
    {-# LANGUAGE LambdaCase    #-}

    -----------------------------------------------------------------------------
    --
    -- Pretty-printing of Cmm as C, suitable for feeding gcc
    --
    -- (c) The University of Glasgow 2004-2006
    --
    -- Print Cmm as real C, for -fvia-C
    --
    -- See wiki:commentary/compiler/backends/ppr-c
    --
    -- This is simpler than the old PprAbsC, because Cmm is "macro-expanded"
    -- relative to the old AbstractC, and many oddities/decorations have
    -- disappeared from the data type.
    --
    -- This code generator is only supported in unregisterised mode.
    --
    -----------------------------------------------------------------------------

    module GHC.CmmToC
       ( cmmToC
       )
    where

    #include "HsVersions.h"

    -- Cmm stuff
    import GHC.Prelude

    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Types.ForeignCall
    import GHC.Cmm hiding (pprBBlock)
    import GHC.Cmm.Ppr () -- For Outputable instances
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Utils
    import GHC.Cmm.Switch

    -- Utils
    import GHC.CmmToAsm.CPrim
    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Data.FastString
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Platform
    import GHC.Types.Unique.Set
    import GHC.Types.Unique.FM
    import GHC.Types.Unique
    import GHC.Utils.Misc

    -- The rest
    import Data.ByteString (ByteString)
    import qualified Data.ByteString as BS
    import Control.Monad.ST
    import Data.Char
    import Data.List (intersperse)
    import Data.Map (Map)
    import Data.Word
    import qualified Data.Map as Map
    import Control.Monad (ap)
    import qualified Data.Array.Unsafe as U ( castSTUArray )
    import Data.Array.ST

    -- --------------------------------------------------------------------------
    -- Now do some real work
    --
    -- for fun, we could call cmmToCmm over the tops...
    --

    cmmToC :: Platform -> RawCmmGroup -> SDoc
    cmmToC :: Platform -> RawCmmGroup -> SDoc
    cmmToC Platform
    platform RawCmmGroup
    tops = ([SDoc] -> SDoc
    vcat forall a b. (a -> b) -> a -> b
    $ forall a. a -> [a] -> [a]
    intersperse SDoc
    blankLine forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> RawCmmDecl -> SDoc
    pprTop Platform
    platform) RawCmmGroup
    tops) SDoc -> SDoc -> SDoc
    $$ SDoc
    blankLine

    --
    -- top level procs
    --
    pprTop :: Platform -> RawCmmDecl -> SDoc
    pprTop :: Platform -> RawCmmDecl -> SDoc
    pprTop Platform
    platform = \case
      (CmmProc LabelMap RawCmmStatics
    infos CLabel
    clbl [GlobalReg]
    _in_live_regs CmmGraph
    graph) ->
        (case 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 of
           Maybe RawCmmStatics
    Nothing -> SDoc
    empty
           Just (CmmStaticsRaw CLabel
    info_clbl [CmmStatic]
    info_dat) ->
               Platform -> [CmmStatic] -> SDoc
    pprDataExterns Platform
    platform [CmmStatic]
    info_dat SDoc -> SDoc -> SDoc
    $$
               Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
    pprWordArray Platform
    platform Bool
    info_is_in_rodata CLabel
    info_clbl [CmmStatic]
    info_dat) SDoc -> SDoc -> SDoc
    $$
        ([SDoc] -> SDoc
    vcat [
               SDoc
    blankLine,
               SDoc
    extern_decls,
               (if (CLabel -> Bool
    externallyVisibleCLabel CLabel
    clbl)
                        then SDoc -> SDoc
    mkFN_ else SDoc -> SDoc
    mkIF_) (Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    clbl) SDoc -> SDoc -> SDoc
    <+> SDoc
    lbrace,
               Int -> SDoc -> SDoc
    nest Int
    8 SDoc
    temp_decls,
               [SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmBlock -> SDoc
    pprBBlock Platform
    platform) [CmmBlock]
    blocks),
               SDoc
    rbrace ]
        )
        where
            -- info tables are always in .rodata
            info_is_in_rodata :: Bool
    info_is_in_rodata = Bool
    True
            blocks :: [CmmBlock]
    blocks = CmmGraph -> [CmmBlock]
    toBlockListEntryFirst CmmGraph
    graph
            (SDoc
    temp_decls, SDoc
    extern_decls) = Platform -> [CmmBlock] -> (SDoc, SDoc)
    pprTempAndExternDecls Platform
    platform [CmmBlock]
    blocks

      -- Chunks of static data.

      -- We only handle (a) arrays of word-sized things and (b) strings.

      (CmmData Section
    section (CmmStaticsRaw CLabel
    lbl [CmmString ByteString
    str])) ->
        Platform -> CLabel -> SDoc
    pprExternDecl Platform
    platform CLabel
    lbl SDoc -> SDoc -> SDoc
    $$
        [SDoc] -> SDoc
    hcat [
          CLabel -> SDoc
    pprLocalness CLabel
    lbl, Bool -> SDoc
    pprConstness (Section -> Bool
    isSecConstant Section
    section), String -> SDoc
    text String
    "char ", Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl,
          String -> SDoc
    text String
    "[] = ", ByteString -> SDoc
    pprStringInCStyle ByteString
    str, SDoc
    semi
        ]

      (CmmData Section
    section (CmmStaticsRaw CLabel
    lbl [CmmUninitialised Int
    size])) ->
        Platform -> CLabel -> SDoc
    pprExternDecl Platform
    platform CLabel
    lbl SDoc -> SDoc -> SDoc
    $$
        [SDoc] -> SDoc
    hcat [
          CLabel -> SDoc
    pprLocalness CLabel
    lbl, Bool -> SDoc
    pprConstness (Section -> Bool
    isSecConstant Section
    section), String -> SDoc
    text String
    "char ", Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl,
          SDoc -> SDoc
    brackets (Int -> SDoc
    int Int
    size), SDoc
    semi
        ]

      (CmmData Section
    section (CmmStaticsRaw CLabel
    lbl [CmmStatic]
    lits)) ->
        Platform -> [CmmStatic] -> SDoc
    pprDataExterns Platform
    platform [CmmStatic]
    lits SDoc -> SDoc -> SDoc
    $$
        Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
    pprWordArray Platform
    platform (Section -> Bool
    isSecConstant Section
    section) CLabel
    lbl [CmmStatic]
    lits
      where
        isSecConstant :: Section -> Bool
    isSecConstant Section
    section = case Section -> SectionProtection
    sectionProtection Section
    section of
          SectionProtection
    ReadOnlySection -> Bool
    True
          SectionProtection
    WriteProtectedSection -> Bool
    True
          SectionProtection
    _ -> Bool
    False

    -- --------------------------------------------------------------------------
    -- BasicBlocks are self-contained entities: they always end in a jump.
    --
    -- Like nativeGen/AsmCodeGen, we could probably reorder blocks to turn
    -- as many jumps as possible into fall throughs.
    --

    pprBBlock :: Platform -> CmmBlock -> SDoc
    pprBBlock :: Platform -> CmmBlock -> SDoc
    pprBBlock Platform
    platform CmmBlock
    block =
      Int -> SDoc -> SDoc
    nest Int
    4 (BlockId -> SDoc
    pprBlockId (forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    block) SDoc -> SDoc -> SDoc
    <> SDoc
    colon) SDoc -> SDoc -> SDoc
    $$
      Int -> SDoc -> SDoc
    nest Int
    8 ([SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map (forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> SDoc
    pprStmt Platform
    platform) (forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    nodes)) SDoc -> SDoc -> SDoc
    $$ forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> SDoc
    pprStmt Platform
    platform CmmNode O C
    last)
     where
      (CmmNode C O
    _, Block CmmNode O O
    nodes, CmmNode O C
    last)  = forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    block

    -- --------------------------------------------------------------------------
    -- Info tables. Just arrays of words.
    -- See codeGen/ClosureInfo, and nativeGen/PprMach

    pprWordArray :: Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
    pprWordArray :: Platform -> Bool -> CLabel -> [CmmStatic] -> SDoc
    pprWordArray Platform
    platform Bool
    is_ro CLabel
    lbl [CmmStatic]
    ds
      = -- TODO: align closures only
        Platform -> CLabel -> SDoc
    pprExternDecl Platform
    platform CLabel
    lbl SDoc -> SDoc -> SDoc
    $$
        [SDoc] -> SDoc
    hcat [ CLabel -> SDoc
    pprLocalness CLabel
    lbl, Bool -> SDoc
    pprConstness Bool
    is_ro, String -> SDoc
    text String
    "StgWord"
             , SDoc
    space, Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl, String -> SDoc
    text String
    "[]"
             -- See Note [StgWord alignment]
             , Width -> SDoc
    pprAlignment (Platform -> Width
    wordWidth Platform
    platform)
             , String -> SDoc
    text String
    "= {" ]
        SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    8 ([SDoc] -> SDoc
    commafy (Platform -> [CmmLit] -> [SDoc]
    staticLitsToWords Platform
    platform forall a b. (a -> b) -> a -> b
    $ [CmmStatic] -> [CmmLit]
    toLits [CmmStatic]
    ds))
        SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "};"
      where
        toLits :: [CmmStatic] -> [CmmLit]
        toLits :: [CmmStatic] -> [CmmLit]
    toLits = forall a b. (a -> b) -> [a] -> [b]
    map CmmStatic -> CmmLit
    f
          where
            f :: CmmStatic -> CmmLit
    f (CmmStaticLit CmmLit
    lit) = CmmLit
    lit
            f CmmStatic
    static             = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "pprWordArray: Unexpected literal"  (Platform -> CmmStatic -> SDoc
    pprStatic Platform
    platform CmmStatic
    static)

    pprAlignment :: Width -> SDoc
    pprAlignment :: Width -> SDoc
    pprAlignment Width
    words =
         String -> SDoc
    text String
    "__attribute__((aligned(" SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int (Width -> Int
    widthInBytes Width
    words) SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ")))"

    -- Note [StgWord alignment]
    -- C codegen builds static closures as StgWord C arrays (pprWordArray).
    -- Their real C type is 'StgClosure'. Macros like UNTAG_CLOSURE assume
    -- pointers to 'StgClosure' are aligned at pointer size boundary:
    --  4 byte boundary on 32 systems
    --  and 8 bytes on 64-bit systems
    -- see TAG_MASK and TAG_BITS definition and usage.
    --
    -- It's a reasonable assumption also known as natural alignment.
    -- Although some architectures have different alignment rules.
    -- One of known exceptions is m68k (#11395, comment:16) where:
    --   __alignof__(StgWord) == 2, sizeof(StgWord) == 4
    --
    -- Thus we explicitly increase alignment by using
    --    __attribute__((aligned(4)))
    -- declaration.

    --
    -- has to be static, if it isn't globally visible
    --
    pprLocalness :: CLabel -> SDoc
    pprLocalness :: CLabel -> SDoc
    pprLocalness CLabel
    lbl | Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ CLabel -> Bool
    externallyVisibleCLabel CLabel
    lbl = String -> SDoc
    text String
    "static "
                     | Bool
    otherwise = SDoc
    empty

    pprConstness :: Bool -> SDoc
    pprConstness :: Bool -> SDoc
    pprConstness Bool
    is_ro | Bool
    is_ro = String -> SDoc
    text String
    "const "
                       | Bool
    otherwise = SDoc
    empty

    -- --------------------------------------------------------------------------
    -- Statements.
    --

    pprStmt :: Platform -> CmmNode e x -> SDoc
    pprStmt :: forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> SDoc
    pprStmt Platform
    platform CmmNode e x
    stmt =
        case CmmNode e x
    stmt of
        CmmEntry{}   -> SDoc
    empty
        CmmComment FastString
    _ -> SDoc
    empty -- (hang (text "/*") 3 (ftext s)) $$ ptext (sLit "*/")
                              -- XXX if the string contains "*/", we need to fix it
                              -- XXX we probably want to emit these comments when
                              -- some debugging option is on.  They can get quite
                              -- large.

        CmmTick CmmTickish
    _ -> SDoc
    empty
        CmmUnwind{} -> SDoc
    empty

        CmmAssign CmmReg
    dest CmmExpr
    src -> Platform -> CmmReg -> CmmExpr -> SDoc
    pprAssign Platform
    platform CmmReg
    dest CmmExpr
    src

        CmmStore  CmmExpr
    dest CmmExpr
    src AlignmentSpec
    align
            | CmmType -> Width
    typeWidth CmmType
    rep forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Platform -> Width
    wordWidth Platform
    platform forall a. Eq a => a -> a -> Bool
    /= Width
    W64
            -> (if CmmType -> Bool
    isFloatType CmmType
    rep then String -> SDoc
    text String
    "ASSIGN_DBL"
                                   else PtrString -> SDoc
    ptext (String -> PtrString
    sLit (String
    "ASSIGN_Word64"))) SDoc -> SDoc -> SDoc
    <>
               SDoc -> SDoc
    parens (SDoc
    mkP_ SDoc -> SDoc -> SDoc
    <> Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    dest SDoc -> SDoc -> SDoc
    <> SDoc
    comma SDoc -> SDoc -> SDoc
    <> Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    src) SDoc -> SDoc -> SDoc
    <> SDoc
    semi

            | Bool
    otherwise
            -> [SDoc] -> SDoc
    hsep [ Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    dest CmmType
    rep AlignmentSpec
    align), SDoc
    equals, Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    src SDoc -> SDoc -> SDoc
    <> SDoc
    semi ]
            where
              rep :: CmmType
    rep = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    src

        CmmUnsafeForeignCall target :: ForeignTarget
    target@(ForeignTarget CmmExpr
    fn ForeignConvention
    conv) [LocalReg]
    results [CmmExpr]
    args ->
            SDoc
    fnCall
            where
            ([ForeignHint]
    res_hints, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    target
            hresults :: [(LocalReg, ForeignHint)]
    hresults = forall a b. [a] -> [b] -> [(a, b)]
    zip [LocalReg]
    results [ForeignHint]
    res_hints
            hargs :: [(CmmExpr, ForeignHint)]
    hargs    = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr]
    args [ForeignHint]
    arg_hints

            ForeignConvention CCallConv
    cconv [ForeignHint]
    _ [ForeignHint]
    _ CmmReturnInfo
    ret = ForeignConvention
    conv

            cast_fn :: SDoc
    cast_fn = SDoc -> SDoc
    parens (Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform (Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCFunType Platform
    platform (Char -> SDoc
    char Char
    '*') CCallConv
    cconv [(LocalReg, ForeignHint)]
    hresults [(CmmExpr, ForeignHint)]
    hargs) CmmExpr
    fn)

            -- See wiki:commentary/compiler/backends/ppr-c#prototypes
            fnCall :: SDoc
    fnCall =
                case CmmExpr
    fn of
                  CmmLit (CmmLabel CLabel
    lbl)
                    | CCallConv
    StdCallConv <- CCallConv
    cconv ->
                        Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCall Platform
    platform (Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl) CCallConv
    cconv [(LocalReg, ForeignHint)]
    hresults [(CmmExpr, ForeignHint)]
    hargs
                            -- stdcall functions must be declared with
                            -- a function type, otherwise the C compiler
                            -- doesn't add the @n suffix to the label.  We
                            -- can't add the @n suffix ourselves, because
                            -- it isn't valid C.
                    | CmmReturnInfo
    CmmNeverReturns <- CmmReturnInfo
    ret ->
                        Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCall Platform
    platform SDoc
    cast_fn CCallConv
    cconv [(LocalReg, ForeignHint)]
    hresults [(CmmExpr, ForeignHint)]
    hargs SDoc -> SDoc -> SDoc
    <> SDoc
    semi
                    | Bool -> Bool
    not (CLabel -> Bool
    isMathFun CLabel
    lbl) ->
                        Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprForeignCall Platform
    platform (Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl) CCallConv
    cconv [(LocalReg, ForeignHint)]
    hresults [(CmmExpr, ForeignHint)]
    hargs
                  CmmExpr
    _ ->
                        Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCall Platform
    platform SDoc
    cast_fn CCallConv
    cconv [(LocalReg, ForeignHint)]
    hresults [(CmmExpr, ForeignHint)]
    hargs SDoc -> SDoc -> SDoc
    <> SDoc
    semi
                            -- for a dynamic call, no declaration is necessary.

        CmmUnsafeForeignCall (PrimTarget CallishMachOp
    MO_Touch) [LocalReg]
    _results [CmmExpr]
    _args -> SDoc
    empty
        CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data Int
    _)) [LocalReg]
    _results [CmmExpr]
    _args -> SDoc
    empty

        CmmUnsafeForeignCall target :: ForeignTarget
    target@(PrimTarget CallishMachOp
    op) [LocalReg]
    results [CmmExpr]
    args ->
            SDoc
    fn_call
          where
            cconv :: CCallConv
    cconv = CCallConv
    CCallConv
            fn :: SDoc
    fn = CallishMachOp -> SDoc
    pprCallishMachOp_for_C CallishMachOp
    op

            ([ForeignHint]
    res_hints, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    target
            hresults :: [(LocalReg, ForeignHint)]
    hresults = forall a b. [a] -> [b] -> [(a, b)]
    zip [LocalReg]
    results [ForeignHint]
    res_hints
            hargs :: [(CmmExpr, ForeignHint)]
    hargs    = forall a b. [a] -> [b] -> [(a, b)]
    zip [CmmExpr]
    args [ForeignHint]
    arg_hints

            fn_call :: SDoc
    fn_call
              -- The mem primops carry an extra alignment arg.
              -- We could maybe emit an alignment directive using this info.
              -- We also need to cast mem primops to prevent conflicts with GCC
              -- builtins (see bug #5967).
              | Just Int
    _align <- CallishMachOp -> Maybe Int
    machOpMemcpyishAlign CallishMachOp
    op
              = (String -> SDoc
    text String
    ";EFF_(" SDoc -> SDoc -> SDoc
    <> SDoc
    fn SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    ')' SDoc -> SDoc -> SDoc
    <> SDoc
    semi) SDoc -> SDoc -> SDoc
    $$
                Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprForeignCall Platform
    platform SDoc
    fn CCallConv
    cconv [(LocalReg, ForeignHint)]
    hresults [(CmmExpr, ForeignHint)]
    hargs
              | Bool
    otherwise
              = Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCall Platform
    platform SDoc
    fn CCallConv
    cconv [(LocalReg, ForeignHint)]
    hresults [(CmmExpr, ForeignHint)]
    hargs

        CmmBranch BlockId
    ident               -> BlockId -> SDoc
    pprBranch BlockId
    ident
        CmmCondBranch CmmExpr
    expr BlockId
    yes BlockId
    no Maybe Bool
    _   -> Platform -> CmmExpr -> BlockId -> BlockId -> SDoc
    pprCondBranch Platform
    platform CmmExpr
    expr BlockId
    yes BlockId
    no
        CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    expr } -> SDoc -> SDoc
    mkJMP_ (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    expr) SDoc -> SDoc -> SDoc
    <> SDoc
    semi
        CmmSwitch CmmExpr
    arg SwitchTargets
    ids             -> Platform -> CmmExpr -> SwitchTargets -> SDoc
    pprSwitch Platform
    platform CmmExpr
    arg SwitchTargets
    ids

        CmmNode e x
    _other -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "PprC.pprStmt" (forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmNode e x
    stmt)

    type Hinted a = (a, ForeignHint)

    pprForeignCall :: Platform -> SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual]
                   -> SDoc
    pprForeignCall :: Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprForeignCall Platform
    platform SDoc
    fn CCallConv
    cconv [(LocalReg, ForeignHint)]
    results [(CmmExpr, ForeignHint)]
    args = SDoc
    fn_call
      where
        fn_call :: SDoc
    fn_call = SDoc -> SDoc
    braces (
                     Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCFunType Platform
    platform (Char -> SDoc
    char Char
    '*' SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "ghcFunPtr") CCallConv
    cconv [(LocalReg, ForeignHint)]
    results [(CmmExpr, ForeignHint)]
    args SDoc -> SDoc -> SDoc
    <> SDoc
    semi
                  SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "ghcFunPtr" SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> SDoc
    cast_fn SDoc -> SDoc -> SDoc
    <> SDoc
    semi
                  SDoc -> SDoc -> SDoc
    $$ Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCall Platform
    platform (String -> SDoc
    text String
    "ghcFunPtr") CCallConv
    cconv [(LocalReg, ForeignHint)]
    results [(CmmExpr, ForeignHint)]
    args SDoc -> SDoc -> SDoc
    <> SDoc
    semi
                 )
        cast_fn :: SDoc
    cast_fn = SDoc -> SDoc
    parens (SDoc -> SDoc
    parens (Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCFunType Platform
    platform (Char -> SDoc
    char Char
    '*') CCallConv
    cconv [(LocalReg, ForeignHint)]
    results [(CmmExpr, ForeignHint)]
    args) SDoc -> SDoc -> SDoc
    <> SDoc
    fn)

    pprCFunType :: Platform -> SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc
    pprCFunType :: Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCFunType Platform
    platform SDoc
    ppr_fn CCallConv
    cconv [(LocalReg, ForeignHint)]
    ress [(CmmExpr, ForeignHint)]
    args
      = let res_type :: [(LocalReg, ForeignHint)] -> SDoc
    res_type [] = String -> SDoc
    text String
    "void"
            res_type [(LocalReg
    one, ForeignHint
    hint)] = Platform -> CmmType -> ForeignHint -> SDoc
    machRepHintCType Platform
    platform (LocalReg -> CmmType
    localRegType LocalReg
    one) ForeignHint
    hint
            res_type [(LocalReg, ForeignHint)]
    _ = forall a. String -> a
    panic String
    "pprCFunType: only void or 1 return value supported"

            arg_type :: (CmmExpr, ForeignHint) -> SDoc
    arg_type (CmmExpr
    expr, ForeignHint
    hint) = Platform -> CmmType -> ForeignHint -> SDoc
    machRepHintCType Platform
    platform (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    expr) ForeignHint
    hint
        in [(LocalReg, ForeignHint)] -> SDoc
    res_type [(LocalReg, ForeignHint)]
    ress SDoc -> SDoc -> SDoc
    <+>
           SDoc -> SDoc
    parens (CCallConv -> SDoc
    ccallConvAttribute CCallConv
    cconv SDoc -> SDoc -> SDoc
    <> SDoc
    ppr_fn) SDoc -> SDoc -> SDoc
    <>
           SDoc -> SDoc
    parens ([SDoc] -> SDoc
    commafy (forall a b. (a -> b) -> [a] -> [b]
    map (CmmExpr, ForeignHint) -> SDoc
    arg_type [(CmmExpr, ForeignHint)]
    args))

    -- ---------------------------------------------------------------------
    -- unconditional branches
    pprBranch :: BlockId -> SDoc
    pprBranch :: BlockId -> SDoc
    pprBranch BlockId
    ident = String -> SDoc
    text String
    "goto" SDoc -> SDoc -> SDoc
    <+> BlockId -> SDoc
    pprBlockId BlockId
    ident SDoc -> SDoc -> SDoc
    <> SDoc
    semi

    -- ---------------------------------------------------------------------
    -- conditional branches to local labels
    pprCondBranch :: Platform -> CmmExpr -> BlockId -> BlockId -> SDoc
    pprCondBranch :: Platform -> CmmExpr -> BlockId -> BlockId -> SDoc
    pprCondBranch Platform
    platform CmmExpr
    expr BlockId
    yes BlockId
    no
            = [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "if" , SDoc -> SDoc
    parens (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    expr) ,
                            String -> SDoc
    text String
    "goto", BlockId -> SDoc
    pprBlockId BlockId
    yes SDoc -> SDoc -> SDoc
    <> SDoc
    semi,
                            String -> SDoc
    text String
    "else goto", BlockId -> SDoc
    pprBlockId BlockId
    no SDoc -> SDoc -> SDoc
    <> SDoc
    semi ]

    -- ---------------------------------------------------------------------
    -- a local table branch
    --
    -- we find the fall-through cases
    --
    pprSwitch :: Platform -> CmmExpr -> SwitchTargets -> SDoc
    pprSwitch :: Platform -> CmmExpr -> SwitchTargets -> SDoc
    pprSwitch Platform
    platform CmmExpr
    e SwitchTargets
    ids
      = (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "switch" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens ( Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    e ) SDoc -> SDoc -> SDoc
    <+> SDoc
    lbrace)
                    Int
    4 ([SDoc] -> SDoc
    vcat ( forall a b. (a -> b) -> [a] -> [b]
    map ([Integer], BlockId) -> SDoc
    caseify [([Integer], BlockId)]
    pairs ) SDoc -> SDoc -> SDoc
    $$ SDoc
    def)) SDoc -> SDoc -> SDoc
    $$ SDoc
    rbrace
      where
        ([([Integer], BlockId)]
    pairs, Maybe BlockId
    mbdef) = SwitchTargets -> ([([Integer], BlockId)], Maybe BlockId)
    switchTargetsFallThrough SwitchTargets
    ids

        -- fall through case
        caseify :: ([Integer], BlockId) -> SDoc
    caseify (Integer
    ix:[Integer]
    ixs, BlockId
    ident) = [SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map Integer -> SDoc
    do_fallthrough [Integer]
    ixs) SDoc -> SDoc -> SDoc
    $$ Integer -> SDoc
    final_branch Integer
    ix
            where
            do_fallthrough :: Integer -> SDoc
    do_fallthrough Integer
    ix =
                     [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "case" , Platform -> Integer -> Width -> SDoc
    pprHexVal Platform
    platform Integer
    ix (Platform -> Width
    wordWidth Platform
    platform) SDoc -> SDoc -> SDoc
    <> SDoc
    colon ,
                            String -> SDoc
    text String
    "/* fall through */" ]

            final_branch :: Integer -> SDoc
    final_branch Integer
    ix =
                    [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "case" , Platform -> Integer -> Width -> SDoc
    pprHexVal Platform
    platform Integer
    ix (Platform -> Width
    wordWidth Platform
    platform) SDoc -> SDoc -> SDoc
    <> SDoc
    colon ,
                           String -> SDoc
    text String
    "goto" , (BlockId -> SDoc
    pprBlockId BlockId
    ident) SDoc -> SDoc -> SDoc
    <> SDoc
    semi ]

        caseify ([Integer]
    _     , BlockId
    _    ) = forall a. String -> a
    panic String
    "pprSwitch: switch with no cases!"

        def :: SDoc
    def | Just BlockId
    l <- Maybe BlockId
    mbdef = String -> SDoc
    text String
    "default: goto" SDoc -> SDoc -> SDoc
    <+> BlockId -> SDoc
    pprBlockId BlockId
    l SDoc -> SDoc -> SDoc
    <> SDoc
    semi
            | Bool
    otherwise       = SDoc
    empty

    -- ---------------------------------------------------------------------
    -- Expressions.
    --

    -- C Types: the invariant is that the C expression generated by
    --
    --      pprExpr e
    --
    -- has a type in C which is also given by
    --
    --      machRepCType (cmmExprType e)
    --
    -- (similar invariants apply to the rest of the pretty printer).

    pprExpr :: Platform -> CmmExpr -> SDoc
    pprExpr :: Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    e = case CmmExpr
    e of
        CmmLit CmmLit
    lit         -> Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit
        CmmLoad CmmExpr
    e CmmType
    ty AlignmentSpec
    align -> Platform -> CmmExpr -> CmmType -> AlignmentSpec -> SDoc
    pprLoad Platform
    platform CmmExpr
    e CmmType
    ty AlignmentSpec
    align
        CmmReg CmmReg
    reg         -> CmmReg -> SDoc
    pprCastReg CmmReg
    reg
        CmmRegOff CmmReg
    reg Int
    0    -> CmmReg -> SDoc
    pprCastReg CmmReg
    reg

        -- CmmRegOff is an alias of MO_Add
        CmmRegOff CmmReg
    reg Int
    i -> CmmReg -> SDoc
    pprCastReg CmmReg
    reg SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '+' SDoc -> SDoc -> SDoc
    <>
                           Platform -> Integer -> Width -> SDoc
    pprHexVal Platform
    platform (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i) (Platform -> Width
    wordWidth Platform
    platform)

        CmmMachOp MachOp
    mop [CmmExpr]
    args -> Platform -> MachOp -> [CmmExpr] -> SDoc
    pprMachOpApp Platform
    platform MachOp
    mop [CmmExpr]
    args

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

    pprLoad :: Platform -> CmmExpr -> CmmType -> AlignmentSpec -> SDoc
    pprLoad :: Platform -> CmmExpr -> CmmType -> AlignmentSpec -> SDoc
    pprLoad Platform
    platform CmmExpr
    e CmmType
    ty AlignmentSpec
    _align
      | Width
    width forall a. Eq a => a -> a -> Bool
    == Width
    W64, Platform -> Width
    wordWidth Platform
    platform forall a. Eq a => a -> a -> Bool
    /= Width
    W64
      = (if CmmType -> Bool
    isFloatType CmmType
    ty then String -> SDoc
    text String
    "PK_DBL"
                           else String -> SDoc
    text String
    "PK_Word64")
        SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens (SDoc
    mkP_ SDoc -> SDoc -> SDoc
    <> Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    e)

      -- TODO: exploit natural-alignment where possible
      | Bool
    otherwise
      = case CmmExpr
    e of
            CmmReg CmmReg
    r | CmmReg -> Bool
    isPtrReg CmmReg
    r Bool -> Bool -> Bool
    && Width
    width forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform Bool -> Bool -> Bool
    && Bool -> Bool
    not (CmmType -> Bool
    isFloatType CmmType
    ty)
                     -> Char -> SDoc
    char Char
    '*' SDoc -> SDoc -> SDoc
    <> CmmReg -> SDoc
    pprAsPtrReg CmmReg
    r

            CmmRegOff CmmReg
    r Int
    0 | CmmReg -> Bool
    isPtrReg CmmReg
    r Bool -> Bool -> Bool
    && Width
    width forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform Bool -> Bool -> Bool
    && Bool -> Bool
    not (CmmType -> Bool
    isFloatType CmmType
    ty)
                          -> Char -> SDoc
    char Char
    '*' SDoc -> SDoc -> SDoc
    <> CmmReg -> SDoc
    pprAsPtrReg CmmReg
    r

            CmmRegOff CmmReg
    r Int
    off | CmmReg -> Bool
    isPtrReg CmmReg
    r Bool -> Bool -> Bool
    && Width
    width forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform
                            , Int
    off forall a. Integral a => a -> a -> a
    `rem` Platform -> Int
    platformWordSizeInBytes Platform
    platform forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Bool -> Bool
    not (CmmType -> Bool
    isFloatType CmmType
    ty)
            -- ToDo: check that the offset is a word multiple?
            --       (For tagging to work, I had to avoid unaligned loads. --ARY)
                            -> CmmReg -> SDoc
    pprAsPtrReg CmmReg
    r SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    brackets (forall a. Outputable a => a -> SDoc
    ppr (Int
    off forall a. Bits a => a -> Int -> a
    `shiftR` Platform -> Int
    wordShift Platform
    platform))

            CmmExpr
    _other -> Platform -> CmmExpr -> CmmType -> SDoc
    cLoad Platform
    platform CmmExpr
    e CmmType
    ty
      where
        width :: Width
    width = CmmType -> Width
    typeWidth CmmType
    ty

    pprExpr1 :: Platform -> CmmExpr -> SDoc
    pprExpr1 :: Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    e = case CmmExpr
    e of
       CmmLit CmmLit
    lit  -> Platform -> CmmLit -> SDoc
    pprLit1 Platform
    platform CmmLit
    lit
       CmmReg CmmReg
    _reg -> Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    e
       CmmExpr
    _           -> SDoc -> SDoc
    parens (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    e)

    -- --------------------------------------------------------------------------
    -- MachOp applications

    pprMachOpApp :: Platform -> MachOp -> [CmmExpr] -> SDoc

    pprMachOpApp :: Platform -> MachOp -> [CmmExpr] -> SDoc
    pprMachOpApp Platform
    platform MachOp
    op [CmmExpr]
    args
      | MachOp -> Bool
    isMulMayOfloOp MachOp
    op
      = String -> SDoc
    text String
    "mulIntMayOflo" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens ([SDoc] -> SDoc
    commafy (forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform) [CmmExpr]
    args))
      where isMulMayOfloOp :: MachOp -> Bool
    isMulMayOfloOp (MO_U_MulMayOflo Width
    _) = Bool
    True
            isMulMayOfloOp (MO_S_MulMayOflo Width
    _) = Bool
    True
            isMulMayOfloOp MachOp
    _ = Bool
    False

    pprMachOpApp Platform
    platform MachOp
    mop [CmmExpr]
    args
      | Just SDoc
    ty <- Platform -> MachOp -> [CmmType] -> Maybe SDoc
    machOpNeedsCast Platform
    platform MachOp
    mop (forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform) [CmmExpr]
    args)
      = SDoc
    ty SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens (Platform -> MachOp -> [CmmExpr] -> SDoc
    pprMachOpApp' Platform
    platform MachOp
    mop [CmmExpr]
    args)
      | Bool
    otherwise
      = Platform -> MachOp -> [CmmExpr] -> SDoc
    pprMachOpApp' Platform
    platform MachOp
    mop [CmmExpr]
    args

    {-
    Note [Zero-extending sub-word signed results]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider a program like (from #20634):

        test() {
            bits64 ret;
            bits8 a,b;
            a = 0xe1 :: bits8;       // == -31 signed
            b = %quot(a, 3::bits8);  // == -10 signed
            ret = %zx64(a);          // == 0xf6 unsigned
            return (ret);
        }

    This program should return 0xf6 == 246. However, we need to be very careful
    with when dealing with the result of the %quot. For instance, one might be
    tempted produce code like:

        StgWord8 a = 0xe1U;
        StgInt8  b = (StgInt8) a / (StgInt8) 0x3U;
        StgWord ret = (W_) b;

    However, this would be wrong; by widening `b` directly from `StgInt8` to
    `StgWord` we will get sign-extension semantics: rather than 0xf6 we will get
    0xfffffffffffffff6. To avoid this we must first cast `b` back to `StgWord8`,
    ensuring that we get zero-extension semantics when we widen up to `StgWord`.

    Note [When in doubt, cast arguments as unsigned]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In general C's signed-ness behavior can lead to surprising results and
    consequently we are very explicit about ensuring that arguments have the
    correct signedness. For instance, consider a program like

        test() {
            bits64 ret, a, b;
            a = %neg(43 :: bits64);
            b = %neg(0x443c70fa3e465120 :: bits64);
            ret = %modu(a, b);
            return (ret);
        }

    In this case both `a` and `b` will be StgInts in the generated C (since
    `MO_Neg` is a signed operation). However, we want to ensure that we perform an
    *unsigned* modulus operation, therefore we must be careful to cast both arguments
    to StgWord. We do this for any operation where the signedness of the argument
    may affect the operation's semantics.
    -}

    -- | The result type of most operations is determined by the operands. However,
    -- there are a few exceptions: particularly operations which might get promoted
    -- to a signed result. For these we explicitly cast the result.
    machOpNeedsCast :: Platform -> MachOp -> [CmmType] -> Maybe SDoc
    machOpNeedsCast :: Platform -> MachOp -> [CmmType] -> Maybe SDoc
    machOpNeedsCast Platform
    platform MachOp
    mop [CmmType]
    args
        -- Comparisons in C have type 'int', but we want type W_ (this is what
        -- resultRepOfMachOp says).
      | MachOp -> Bool
    isComparisonMachOp MachOp
    mop = forall a. a -> Maybe a
    Just SDoc
    mkW_

        -- See Note [Zero-extended sub-word signed results]
      | MachOp -> Bool
    signedOp MachOp
    mop
      , CmmType
    res_ty <- Platform -> MachOp -> [CmmType] -> CmmType
    machOpResultType Platform
    platform MachOp
    mop [CmmType]
    args
      , Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ CmmType -> Bool
    isFloatType CmmType
    res_ty -- only integer operations, not MO_SF_Conv
      , let w :: Width
    w = CmmType -> Width
    typeWidth CmmType
    res_ty
      , Width
    w forall a. Ord a => a -> a -> Bool
    < Platform -> Width
    wordWidth Platform
    platform
      = Width -> Maybe SDoc
    cast_it Width
    w

        -- A shift operation like (a >> b) where a::Word8 and b::Word has type Word
        -- in C yet we want a Word8
      | Just Width
    w <- MachOp -> Maybe Width
    shiftOp MachOp
    mop  = Width -> Maybe SDoc
    cast_it Width
    w

        -- The results of these operations may be promoted to signed values
        -- due to C11 section 6.3.1.1.
      | MO_Add Width
    w <- MachOp
    mop        = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_Sub Width
    w <- MachOp
    mop        = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_Mul Width
    w <- MachOp
    mop        = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_U_Quot Width
    w <- MachOp
    mop     = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_U_Rem  Width
    w <- MachOp
    mop     = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_And Width
    w <- MachOp
    mop        = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_Or  Width
    w <- MachOp
    mop        = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_Xor Width
    w <- MachOp
    mop        = Width -> Maybe SDoc
    cast_it Width
    w
      | MO_Not Width
    w <- MachOp
    mop        = Width -> Maybe SDoc
    cast_it Width
    w

      | Bool
    otherwise              = forall a. Maybe a
    Nothing
      where
        cast_it :: Width -> Maybe SDoc
    cast_it Width
    w =
          let ty :: SDoc
    ty = Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform Width
    w
          in forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ SDoc -> SDoc
    parens SDoc
    ty

    pprMachOpApp' :: Platform -> MachOp -> [CmmExpr] -> SDoc
    pprMachOpApp' :: Platform -> MachOp -> [CmmExpr] -> SDoc
    pprMachOpApp' Platform
    platform MachOp
    mop [CmmExpr]
    args
     = case [CmmExpr]
    args of
        -- dyadic
        [CmmExpr
    x,CmmExpr
    y] -> CmmExpr -> SDoc
    pprArg CmmExpr
    x SDoc -> SDoc -> SDoc
    <+> Platform -> MachOp -> SDoc
    pprMachOp_for_C Platform
    platform MachOp
    mop SDoc -> SDoc -> SDoc
    <+> CmmExpr -> SDoc
    pprArg CmmExpr
    y

        -- unary
        [CmmExpr
    x]   -> Platform -> MachOp -> SDoc
    pprMachOp_for_C Platform
    platform MachOp
    mop SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens (CmmExpr -> SDoc
    pprArg CmmExpr
    x)

        [CmmExpr]
    _     -> forall a. String -> a
    panic String
    "PprC.pprMachOp : machop with wrong number of args"

      where
        pprArg :: CmmExpr -> SDoc
    pprArg CmmExpr
    e
          | MachOp -> Bool
    needsFCasts MachOp
    mop = Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform (Width -> SDoc
    machRep_F_CType Width
    width) CmmExpr
    e
            -- Cast needed for signed integer ops
          | MachOp -> Bool
    signedOp    MachOp
    mop = Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform (Platform -> Width -> SDoc
    machRep_S_CType Platform
    platform Width
    width) CmmExpr
    e
            -- See Note [When in doubt, cast arguments as unsigned]
          | MachOp -> Bool
    needsUnsignedCast MachOp
    mop
                            = Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform (Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform Width
    width) CmmExpr
    e
          | Bool
    otherwise       = Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    e
          where
            width :: Width
    width = CmmType -> Width
    typeWidth (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    e)

        needsFCasts :: MachOp -> Bool
    needsFCasts (MO_F_Neg Width
    _)  = Bool
    True
        needsFCasts (MO_F_Quot Width
    _) = Bool
    True
        needsFCasts MachOp
    mop  = MachOp -> Bool
    floatComparison MachOp
    mop

        -- See Note [When in doubt, cast arguments as unsigned]
        needsUnsignedCast :: MachOp -> Bool
    needsUnsignedCast (MO_Mul    Width
    _) = Bool
    True
        needsUnsignedCast (MO_U_Shr  Width
    _) = Bool
    True
        needsUnsignedCast (MO_U_Quot Width
    _) = Bool
    True
        needsUnsignedCast (MO_U_Rem  Width
    _) = Bool
    True
        needsUnsignedCast (MO_U_Ge   Width
    _) = Bool
    True
        needsUnsignedCast (MO_U_Le   Width
    _) = Bool
    True
        needsUnsignedCast (MO_U_Gt   Width
    _) = Bool
    True
        needsUnsignedCast (MO_U_Lt   Width
    _) = Bool
    True
        needsUnsignedCast MachOp
    _             = Bool
    False

    -- --------------------------------------------------------------------------
    -- Literals

    pprLit :: Platform -> CmmLit -> SDoc
    pprLit :: Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit = case CmmLit
    lit of
        CmmInt Integer
    i Width
    rep      -> Platform -> Integer -> Width -> SDoc
    pprHexVal Platform
    platform Integer
    i Width
    rep

        CmmFloat Rational
    f Width
    w       -> SDoc -> SDoc
    parens (Width -> SDoc
    machRep_F_CType Width
    w) SDoc -> SDoc -> SDoc
    <> SDoc
    str
            where d :: Double
    d = forall a. Fractional a => Rational -> a
    fromRational Rational
    f :: Double
                  str :: SDoc
    str | forall a. RealFloat a => a -> Bool
    isInfinite Double
    d Bool -> Bool -> Bool
    && Double
    d forall a. Ord a => a -> a -> Bool
    < Double
    0 = String -> SDoc
    text String
    "-INFINITY"
                      | forall a. RealFloat a => a -> Bool
    isInfinite Double
    d          = String -> SDoc
    text String
    "INFINITY"
                      | forall a. RealFloat a => a -> Bool
    isNaN Double
    d               = String -> SDoc
    text String
    "NAN"
                      | Bool
    otherwise             = String -> SDoc
    text (forall a. Show a => a -> String
    show Double
    d)
                    -- these constants come from <math.h>
                    -- see #1861

        CmmVec {} -> forall a. String -> a
    panic String
    "PprC printing vector literal"

        CmmBlock BlockId
    bid       -> SDoc
    mkW_ SDoc -> SDoc -> SDoc
    <> CLabel -> SDoc
    pprCLabelAddr (BlockId -> CLabel
    infoTblLbl BlockId
    bid)
        CmmLit
    CmmHighStackMark   -> forall a. String -> a
    panic String
    "PprC printing high stack mark"
        CmmLabel CLabel
    clbl      -> SDoc
    mkW_ SDoc -> SDoc -> SDoc
    <> CLabel -> SDoc
    pprCLabelAddr CLabel
    clbl
        CmmLabelOff CLabel
    clbl Int
    i -> SDoc
    mkW_ SDoc -> SDoc -> SDoc
    <> CLabel -> SDoc
    pprCLabelAddr CLabel
    clbl SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '+' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    i
        CmmLabelDiffOff CLabel
    clbl1 CLabel
    _ Int
    i Width
    _   -- non-word widths not supported via C
            -- WARNING:
            --  * the lit must occur in the info table clbl2
            --  * clbl1 must be an SRT, a slow entry point or a large bitmap
            -> SDoc
    mkW_ SDoc -> SDoc -> SDoc
    <> CLabel -> SDoc
    pprCLabelAddr CLabel
    clbl1 SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '+' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    i

        where
            pprCLabelAddr :: CLabel -> SDoc
    pprCLabelAddr CLabel
    lbl = Char -> SDoc
    char Char
    '&' SDoc -> SDoc -> SDoc
    <> Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl

    pprLit1 :: Platform -> CmmLit -> SDoc
    pprLit1 :: Platform -> CmmLit -> SDoc
    pprLit1 Platform
    platform CmmLit
    lit = case CmmLit
    lit of
       (CmmLabelOff CLabel
    _ Int
    _)         -> SDoc -> SDoc
    parens (Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit)
       (CmmLabelDiffOff CLabel
    _ CLabel
    _ Int
    _ Width
    _) -> SDoc -> SDoc
    parens (Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit)
       (CmmFloat Rational
    _ Width
    _)            -> SDoc -> SDoc
    parens (Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit)
       CmmLit
    _                         -> Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit

    -- ---------------------------------------------------------------------------
    -- Static data

    -- | Produce a list of word sized literals encoding the given list of 'CmmLit's.
    staticLitsToWords :: Platform -> [CmmLit] -> [SDoc]
    staticLitsToWords :: Platform -> [CmmLit] -> [SDoc]
    staticLitsToWords Platform
    platform = [CmmLit] -> [SDoc]
    go forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap CmmLit -> [CmmLit]
    decomposeMultiWord
      where
        -- rem_bytes is how many bytes remain in the word we are currently filling.
        -- accum is the word we are filling.
        go :: [CmmLit] -> [SDoc]
        go :: [CmmLit] -> [SDoc]
    go [] = []
        go lits :: [CmmLit]
    lits@(CmmLit
    lit : [CmmLit]
    _)
          | Just (Integer, Width)
    _ <- CmmLit -> Maybe (Integer, Width)
    isSubWordLit CmmLit
    lit
          = Int -> Integer -> [CmmLit] -> [SDoc]
    goSubWord Int
    wordWidthBytes Integer
    0 [CmmLit]
    lits
        go (CmmLit
    lit : [CmmLit]
    rest)
          = Platform -> CmmLit -> SDoc
    pprLit1 Platform
    platform CmmLit
    lit forall a. a -> [a] -> [a]
    : [CmmLit] -> [SDoc]
    go [CmmLit]
    rest

        goSubWord :: Int -> Integer -> [CmmLit] -> [SDoc]
        goSubWord :: Int -> Integer -> [CmmLit] -> [SDoc]
    goSubWord Int
    rem_bytes Integer
    accum (CmmLit
    lit : [CmmLit]
    rest)
          | Just (Integer
    bytes, Width
    w) <- CmmLit -> Maybe (Integer, Width)
    isSubWordLit CmmLit
    lit
          , Int
    rem_bytes forall a. Ord a => a -> a -> Bool
    >= Width -> Int
    widthInBytes Width
    w
          = let accum' :: Integer
    accum' = (Integer
    accum forall a. Bits a => a -> Int -> a
    `shiftL` Width -> Int
    widthInBits Width
    w) forall a. Bits a => a -> a -> a
    .|. Width -> Integer -> Integer
    fixEndian Width
    w Integer
    bytes
            in Int -> Integer -> [CmmLit] -> [SDoc]
    goSubWord (Int
    rem_bytes forall a. Num a => a -> a -> a
    - Width -> Int
    widthInBytes Width
    w) Integer
    accum' [CmmLit]
    rest
        goSubWord Int
    rem_bytes Integer
    accum [CmmLit]
    rest
          = Integer -> SDoc
    pprWord (Width -> Integer -> Integer
    fixEndian (Platform -> Width
    wordWidth Platform
    platform) forall a b. (a -> b) -> a -> b
    $ Integer
    accum forall a. Bits a => a -> Int -> a
    `shiftL` (Int
    8forall a. Num a => a -> a -> a
    *Int
    rem_bytes)) forall a. a -> [a] -> [a]
    : [CmmLit] -> [SDoc]
    go [CmmLit]
    rest

        fixEndian :: Width -> Integer -> Integer
        fixEndian :: Width -> Integer -> Integer
    fixEndian Width
    w = case Platform -> ByteOrder
    platformByteOrder Platform
    platform of
          ByteOrder
    BigEndian    -> forall a. a -> a
    id
          ByteOrder
    LittleEndian -> Width -> Integer -> Integer
    byteSwap Width
    w

        -- Decompose multi-word or floating-point literals into multiple
        -- single-word (or smaller) literals.
        decomposeMultiWord :: CmmLit -> [CmmLit]
        decomposeMultiWord :: CmmLit -> [CmmLit]
    decomposeMultiWord (CmmFloat Rational
    n Width
    W64)
          -- This will produce a W64 integer, which will then be broken up further
          -- on the next iteration on 32-bit platforms.
          = [Rational -> CmmLit
    doubleToWord64 Rational
    n]
        decomposeMultiWord (CmmFloat Rational
    n Width
    W32)
          = [Rational -> CmmLit
    floatToWord32 Rational
    n]
        decomposeMultiWord (CmmInt Integer
    n Width
    W64)
          | Width
    W32 <- Platform -> Width
    wordWidth Platform
    platform
          = [Integer -> Width -> CmmLit
    CmmInt Integer
    hi Width
    W32, Integer -> Width -> CmmLit
    CmmInt Integer
    lo Width
    W32]
          where
            hi :: Integer
    hi = Integer
    n forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32
            lo :: Integer
    lo = Integer
    n forall a. Bits a => a -> a -> a
    .&. Integer
    0xffffffff
        decomposeMultiWord CmmLit
    lit = [CmmLit
    lit]

        -- Decompose a sub-word-sized literal into the integer value and its
        -- (sub-word-sized) width.
        isSubWordLit :: CmmLit -> Maybe (Integer, Width)
        isSubWordLit :: CmmLit -> Maybe (Integer, Width)
    isSubWordLit CmmLit
    lit =
          case CmmLit
    lit of
            CmmInt Integer
    n Width
    w
              | Width
    w forall a. Ord a => a -> a -> Bool
    < Platform -> Width
    wordWidth Platform
    platform   -> forall a. a -> Maybe a
    Just (Integer
    n, Width
    w)
            CmmLit
    _                            -> forall a. Maybe a
    Nothing

        wordWidthBytes :: Int
    wordWidthBytes = Width -> Int
    widthInBytes forall a b. (a -> b) -> a -> b
    $ Platform -> Width
    wordWidth Platform
    platform

        pprWord :: Integer -> SDoc
        pprWord :: Integer -> SDoc
    pprWord Integer
    n = Platform -> Integer -> Width -> SDoc
    pprHexVal Platform
    platform Integer
    n (Platform -> Width
    wordWidth Platform
    platform)

    byteSwap :: Width -> Integer -> Integer
    byteSwap :: Width -> Integer -> Integer
    byteSwap Width
    width Integer
    n = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' forall a. Bits a => a -> a -> a
    f Integer
    0 [Integer]
    bytes
      where
        f :: a -> a -> a
    f a
    acc a
    m = (a
    acc forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) forall a. Bits a => a -> a -> a
    .|. a
    m
        bytes :: [Integer]
    bytes = [ Int -> Integer
    byte Int
    i | Int
    i <- [Int
    0..Width -> Int
    widthInBytes Width
    width forall a. Num a => a -> a -> a
    - Int
    1] ]
        byte :: Int -> Integer
    byte Int
    i = (Integer
    n forall a. Bits a => a -> Int -> a
    `shiftR` (Int
    iforall a. Num a => a -> a -> a
    *Int
    8)) forall a. Bits a => a -> a -> a
    .&. Integer
    0xff

    pprStatic :: Platform -> CmmStatic -> SDoc
    pprStatic :: Platform -> CmmStatic -> SDoc
    pprStatic Platform
    platform CmmStatic
    s = case CmmStatic
    s of

        CmmStaticLit CmmLit
    lit   -> Int -> SDoc -> SDoc
    nest Int
    4 (Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit)
        CmmUninitialised Int
    i -> Int -> SDoc -> SDoc
    nest Int
    4 (SDoc
    mkC_ SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    brackets (Int -> SDoc
    int Int
    i))

        -- these should be inlined, like the old .hc
        CmmString ByteString
    s'       -> Int -> SDoc -> SDoc
    nest Int
    4 (SDoc
    mkW_ SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens(ByteString -> SDoc
    pprStringInCStyle ByteString
    s'))
        CmmFileEmbed {}    -> forall a. String -> a
    panic String
    "Unexpected CmmFileEmbed literal"

    -- ---------------------------------------------------------------------------
    -- Block Ids

    pprBlockId :: BlockId -> SDoc
    pprBlockId :: BlockId -> SDoc
    pprBlockId BlockId
    b = Char -> SDoc
    char Char
    '_' SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr (forall a. Uniquable a => a -> Unique
    getUnique BlockId
    b)

    -- --------------------------------------------------------------------------
    -- Print a MachOp in a way suitable for emitting via C.
    --

    pprMachOp_for_C :: Platform -> MachOp -> SDoc

    pprMachOp_for_C :: Platform -> MachOp -> SDoc
    pprMachOp_for_C Platform
    platform MachOp
    mop = case MachOp
    mop of

            -- Integer operations
            MO_Add          Width
    _ -> Char -> SDoc
    char Char
    '+'
            MO_Sub          Width
    _ -> Char -> SDoc
    char Char
    '-'
            MO_Eq           Width
    _ -> String -> SDoc
    text String
    "=="
            MO_Ne           Width
    _ -> String -> SDoc
    text String
    "!="
            MO_Mul          Width
    _ -> Char -> SDoc
    char Char
    '*'

            MO_S_Quot       Width
    _ -> Char -> SDoc
    char Char
    '/'
            MO_S_Rem        Width
    _ -> Char -> SDoc
    char Char
    '%'
            MO_S_Neg        Width
    _ -> Char -> SDoc
    char Char
    '-'

            MO_U_Quot       Width
    _ -> Char -> SDoc
    char Char
    '/'
            MO_U_Rem        Width
    _ -> Char -> SDoc
    char Char
    '%'

            -- & Floating-point operations
            MO_F_Add        Width
    _ -> Char -> SDoc
    char Char
    '+'
            MO_F_Sub        Width
    _ -> Char -> SDoc
    char Char
    '-'
            MO_F_Neg        Width
    _ -> Char -> SDoc
    char Char
    '-'
            MO_F_Mul        Width
    _ -> Char -> SDoc
    char Char
    '*'
            MO_F_Quot       Width
    _ -> Char -> SDoc
    char Char
    '/'

            -- Signed comparisons
            MO_S_Ge         Width
    _ -> String -> SDoc
    text String
    ">="
            MO_S_Le         Width
    _ -> String -> SDoc
    text String
    "<="
            MO_S_Gt         Width
    _ -> Char -> SDoc
    char Char
    '>'
            MO_S_Lt         Width
    _ -> Char -> SDoc
    char Char
    '<'

            -- & Unsigned comparisons
            MO_U_Ge         Width
    _ -> String -> SDoc
    text String
    ">="
            MO_U_Le         Width
    _ -> String -> SDoc
    text String
    "<="
            MO_U_Gt         Width
    _ -> Char -> SDoc
    char Char
    '>'
            MO_U_Lt         Width
    _ -> Char -> SDoc
    char Char
    '<'

            -- & Floating-point comparisons
            MO_F_Eq         Width
    _ -> String -> SDoc
    text String
    "=="
            MO_F_Ne         Width
    _ -> String -> SDoc
    text String
    "!="
            MO_F_Ge         Width
    _ -> String -> SDoc
    text String
    ">="
            MO_F_Le         Width
    _ -> String -> SDoc
    text String
    "<="
            MO_F_Gt         Width
    _ -> Char -> SDoc
    char Char
    '>'
            MO_F_Lt         Width
    _ -> Char -> SDoc
    char Char
    '<'

            -- Bitwise operations.  Not all of these may be supported at all
            -- sizes, and only integral MachReps are valid.
            MO_And          Width
    _ -> Char -> SDoc
    char Char
    '&'
            MO_Or           Width
    _ -> Char -> SDoc
    char Char
    '|'
            MO_Xor          Width
    _ -> Char -> SDoc
    char Char
    '^'
            MO_Not          Width
    _ -> Char -> SDoc
    char Char
    '~'
            MO_Shl          Width
    _ -> String -> SDoc
    text String
    "<<"
            MO_U_Shr        Width
    _ -> String -> SDoc
    text String
    ">>" -- unsigned shift right
            MO_S_Shr        Width
    _ -> String -> SDoc
    text String
    ">>" -- signed shift right

    -- Conversions.  Some of these will be NOPs, but never those that convert
    -- between ints and floats.
    -- Floating-point conversions use the signed variant.
    -- We won't know to generate (void*) casts here, but maybe from
    -- context elsewhere

    -- noop casts
            MO_UU_Conv Width
    from Width
    to | Width
    from forall a. Eq a => a -> a -> Bool
    == Width
    to -> SDoc
    empty
            MO_UU_Conv Width
    _from Width
    to -> SDoc -> SDoc
    parens (Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform Width
    to)

            MO_SS_Conv Width
    from Width
    to | Width
    from forall a. Eq a => a -> a -> Bool
    == Width
    to -> SDoc
    empty
            MO_SS_Conv Width
    _from Width
    to -> SDoc -> SDoc
    parens (Platform -> Width -> SDoc
    machRep_S_CType Platform
    platform Width
    to)

            MO_XX_Conv Width
    from Width
    to | Width
    from forall a. Eq a => a -> a -> Bool
    == Width
    to -> SDoc
    empty
            MO_XX_Conv Width
    _from Width
    to -> SDoc -> SDoc
    parens (Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform Width
    to)

            MO_FF_Conv Width
    from Width
    to | Width
    from forall a. Eq a => a -> a -> Bool
    == Width
    to -> SDoc
    empty
            MO_FF_Conv Width
    _from Width
    to -> SDoc -> SDoc
    parens (Width -> SDoc
    machRep_F_CType Width
    to)

            MO_SF_Conv Width
    _from Width
    to -> SDoc -> SDoc
    parens (Width -> SDoc
    machRep_F_CType Width
    to)
            MO_FS_Conv Width
    _from Width
    to -> SDoc -> SDoc
    parens (Platform -> Width -> SDoc
    machRep_S_CType Platform
    platform Width
    to)

            MO_S_MulMayOflo Width
    _ -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_S_MulMayOflo")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_S_MulMayOflo"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_U_MulMayOflo Width
    _ -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_U_MulMayOflo")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_U_MulMayOflo"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")

            MO_V_Insert {}    -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_V_Insert")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_V_Insert"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_V_Extract {}   -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_V_Extract")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_V_Extract"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")

            MO_V_Add {}       -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_V_Add")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_V_Add"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_V_Sub {}       -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_V_Sub")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_V_Sub"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_V_Mul {}       -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_V_Mul")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_V_Mul"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")

            MO_VS_Quot {}     -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VS_Quot")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VS_Quot"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VS_Rem {}      -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VS_Rem")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VS_Rem"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VS_Neg {}      -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VS_Neg")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VS_Neg"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")

            MO_VU_Quot {}     -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VU_Quot")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VU_Quot"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VU_Rem {}      -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VU_Rem")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VU_Rem"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")

            MO_VF_Insert {}   -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VF_Insert")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VF_Insert"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VF_Extract {}  -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VF_Extract")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VF_Extract"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")

            MO_VF_Add {}      -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VF_Add")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VF_Add"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VF_Sub {}      -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VF_Sub")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VF_Sub"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VF_Neg {}      -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VF_Neg")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VF_Neg"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VF_Mul {}      -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VF_Mul")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VF_Mul"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")
            MO_VF_Quot {}     -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "offending mop:"
                                    (String -> SDoc
    text String
    "MO_VF_Quot")
                                    (forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "PprC.pprMachOp_for_C: MO_VF_Quot"
                                          forall a. [a] -> [a] -> [a]
    ++ String
    " should have been handled earlier!")

            MO_AlignmentCheck {} -> forall a. String -> a
    panic String
    "-falignment-santisation not supported by unregisterised backend"

    signedOp :: MachOp -> Bool      -- Argument type(s) are signed ints
    signedOp :: MachOp -> Bool
    signedOp (MO_S_Quot Width
    _)    = Bool
    True
    signedOp (MO_S_Rem  Width
    _)    = Bool
    True
    signedOp (MO_S_Neg  Width
    _)    = Bool
    True
    signedOp (MO_S_Ge   Width
    _)    = Bool
    True
    signedOp (MO_S_Le   Width
    _)    = Bool
    True
    signedOp (MO_S_Gt   Width
    _)    = Bool
    True
    signedOp (MO_S_Lt   Width
    _)    = Bool
    True
    signedOp (MO_S_Shr  Width
    _)    = Bool
    True
    signedOp (MO_SS_Conv Width
    _ Width
    _) = Bool
    True
    signedOp (MO_SF_Conv Width
    _ Width
    _) = Bool
    True
    signedOp MachOp
    _                = Bool
    False

    shiftOp :: MachOp -> Maybe Width
    shiftOp :: MachOp -> Maybe Width
    shiftOp (MO_Shl Width
    w)        = forall a. a -> Maybe a
    Just Width
    w
    shiftOp (MO_U_Shr Width
    w)      = forall a. a -> Maybe a
    Just Width
    w
    shiftOp (MO_S_Shr Width
    w)      = forall a. a -> Maybe a
    Just Width
    w
    shiftOp MachOp
    _                 = forall a. Maybe a
    Nothing

    floatComparison :: MachOp -> Bool  -- comparison between float args
    floatComparison :: MachOp -> Bool
    floatComparison (MO_F_Eq   Width
    _) = Bool
    True
    floatComparison (MO_F_Ne   Width
    _) = Bool
    True
    floatComparison (MO_F_Ge   Width
    _) = Bool
    True
    floatComparison (MO_F_Le   Width
    _) = Bool
    True
    floatComparison (MO_F_Gt   Width
    _) = Bool
    True
    floatComparison (MO_F_Lt   Width
    _) = Bool
    True
    floatComparison MachOp
    _             = Bool
    False

    -- ---------------------------------------------------------------------
    -- tend to be implemented by foreign calls

    pprCallishMachOp_for_C :: CallishMachOp -> SDoc

    pprCallishMachOp_for_C :: CallishMachOp -> SDoc
    pprCallishMachOp_for_C CallishMachOp
    mop
        = case CallishMachOp
    mop of
            CallishMachOp
    MO_F64_Pwr      -> String -> SDoc
    text String
    "pow"
            CallishMachOp
    MO_F64_Sin      -> String -> SDoc
    text String
    "sin"
            CallishMachOp
    MO_F64_Cos      -> String -> SDoc
    text String
    "cos"
            CallishMachOp
    MO_F64_Tan      -> String -> SDoc
    text String
    "tan"
            CallishMachOp
    MO_F64_Sinh     -> String -> SDoc
    text String
    "sinh"
            CallishMachOp
    MO_F64_Cosh     -> String -> SDoc
    text String
    "cosh"
            CallishMachOp
    MO_F64_Tanh     -> String -> SDoc
    text String
    "tanh"
            CallishMachOp
    MO_F64_Asin     -> String -> SDoc
    text String
    "asin"
            CallishMachOp
    MO_F64_Acos     -> String -> SDoc
    text String
    "acos"
            CallishMachOp
    MO_F64_Atanh    -> String -> SDoc
    text String
    "atanh"
            CallishMachOp
    MO_F64_Asinh    -> String -> SDoc
    text String
    "asinh"
            CallishMachOp
    MO_F64_Acosh    -> String -> SDoc
    text String
    "acosh"
            CallishMachOp
    MO_F64_Atan     -> String -> SDoc
    text String
    "atan"
            CallishMachOp
    MO_F64_Log      -> String -> SDoc
    text String
    "log"
            CallishMachOp
    MO_F64_Log1P    -> String -> SDoc
    text String
    "log1p"
            CallishMachOp
    MO_F64_Exp      -> String -> SDoc
    text String
    "exp"
            CallishMachOp
    MO_F64_ExpM1    -> String -> SDoc
    text String
    "expm1"
            CallishMachOp
    MO_F64_Sqrt     -> String -> SDoc
    text String
    "sqrt"
            CallishMachOp
    MO_F64_Fabs     -> String -> SDoc
    text String
    "fabs"
            CallishMachOp
    MO_F32_Pwr      -> String -> SDoc
    text String
    "powf"
            CallishMachOp
    MO_F32_Sin      -> String -> SDoc
    text String
    "sinf"
            CallishMachOp
    MO_F32_Cos      -> String -> SDoc
    text String
    "cosf"
            CallishMachOp
    MO_F32_Tan      -> String -> SDoc
    text String
    "tanf"
            CallishMachOp
    MO_F32_Sinh     -> String -> SDoc
    text String
    "sinhf"
            CallishMachOp
    MO_F32_Cosh     -> String -> SDoc
    text String
    "coshf"
            CallishMachOp
    MO_F32_Tanh     -> String -> SDoc
    text String
    "tanhf"
            CallishMachOp
    MO_F32_Asin     -> String -> SDoc
    text String
    "asinf"
            CallishMachOp
    MO_F32_Acos     -> String -> SDoc
    text String
    "acosf"
            CallishMachOp
    MO_F32_Atan     -> String -> SDoc
    text String
    "atanf"
            CallishMachOp
    MO_F32_Asinh    -> String -> SDoc
    text String
    "asinhf"
            CallishMachOp
    MO_F32_Acosh    -> String -> SDoc
    text String
    "acoshf"
            CallishMachOp
    MO_F32_Atanh    -> String -> SDoc
    text String
    "atanhf"
            CallishMachOp
    MO_F32_Log      -> String -> SDoc
    text String
    "logf"
            CallishMachOp
    MO_F32_Log1P    -> String -> SDoc
    text String
    "log1pf"
            CallishMachOp
    MO_F32_Exp      -> String -> SDoc
    text String
    "expf"
            CallishMachOp
    MO_F32_ExpM1    -> String -> SDoc
    text String
    "expm1f"
            CallishMachOp
    MO_F32_Sqrt     -> String -> SDoc
    text String
    "sqrtf"
            CallishMachOp
    MO_F32_Fabs     -> String -> SDoc
    text String
    "fabsf"
            CallishMachOp
    MO_ReadBarrier  -> String -> SDoc
    text String
    "load_load_barrier"
            CallishMachOp
    MO_WriteBarrier -> String -> SDoc
    text String
    "write_barrier"
            MO_Memcpy Int
    _     -> String -> SDoc
    text String
    "memcpy"
            MO_Memset Int
    _     -> String -> SDoc
    text String
    "memset"
            MO_Memmove Int
    _    -> String -> SDoc
    text String
    "memmove"
            MO_Memcmp Int
    _     -> String -> SDoc
    text String
    "memcmp"
            (MO_BSwap Width
    w)    -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    bSwapLabel Width
    w)
            (MO_BRev Width
    w)     -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    bRevLabel Width
    w)
            (MO_PopCnt Width
    w)   -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    popCntLabel Width
    w)
            (MO_Pext Width
    w)     -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    pextLabel Width
    w)
            (MO_Pdep Width
    w)     -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    pdepLabel Width
    w)
            (MO_Clz Width
    w)      -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    clzLabel Width
    w)
            (MO_Ctz Width
    w)      -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    ctzLabel Width
    w)
            (MO_AtomicRMW Width
    w AtomicMachOp
    amop) -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> AtomicMachOp -> String
    atomicRMWLabel Width
    w AtomicMachOp
    amop)
            (MO_Cmpxchg Width
    w)  -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    cmpxchgLabel Width
    w)
            (MO_Xchg Width
    w)     -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    xchgLabel Width
    w)
            (MO_AtomicRead Width
    w)  -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    atomicReadLabel Width
    w)
            (MO_AtomicWrite Width
    w) -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    atomicWriteLabel Width
    w)
            (MO_UF_Conv Width
    w)  -> PtrString -> SDoc
    ptext (String -> PtrString
    sLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    word2FloatLabel Width
    w)

            MO_S_Mul2     {} -> SDoc
    unsupported
            MO_S_QuotRem  {} -> SDoc
    unsupported
            MO_U_QuotRem  {} -> SDoc
    unsupported
            MO_U_QuotRem2 {} -> SDoc
    unsupported
            MO_Add2       {} -> SDoc
    unsupported
            MO_AddWordC   {} -> SDoc
    unsupported
            MO_SubWordC   {} -> SDoc
    unsupported
            MO_AddIntC    {} -> SDoc
    unsupported
            MO_SubIntC    {} -> SDoc
    unsupported
            MO_U_Mul2     {} -> SDoc
    unsupported
            CallishMachOp
    MO_Touch         -> SDoc
    unsupported
            -- we could support prefetch via "__builtin_prefetch"
            -- Not adding it for now
            (MO_Prefetch_Data Int
    _ ) -> SDoc
    unsupported

            CallishMachOp
    MO_I64_ToI   -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_FromI -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_ToW   -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_FromW -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Neg   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Add   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Sub   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Mul   -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_Quot  -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_Rem   -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_Quot  -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_Rem   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_And   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Or    -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Xor   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Not   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Shl   -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_Shr   -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_Shr   -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Eq    -> SDoc
    dontReach64
            CallishMachOp
    MO_x64_Ne    -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_Ge    -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_Gt    -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_Le    -> SDoc
    dontReach64
            CallishMachOp
    MO_I64_Lt    -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_Ge    -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_Gt    -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_Le    -> SDoc
    dontReach64
            CallishMachOp
    MO_W64_Lt    -> SDoc
    dontReach64
        where unsupported :: SDoc
    unsupported = forall a. String -> a
    panic (String
    "pprCallishMachOp_for_C: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show CallishMachOp
    mop
                                forall a. [a] -> [a] -> [a]
    ++ String
    " not supported!")
              dontReach64 :: SDoc
    dontReach64 = forall a. String -> a
    panic (String
    "pprCallishMachOp_for_C: " 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.")

    -- ---------------------------------------------------------------------
    -- Useful #defines
    --

    mkJMP_, mkFN_, mkIF_ :: SDoc -> SDoc

    mkJMP_ :: SDoc -> SDoc
    mkJMP_ SDoc
    i = String -> SDoc
    text String
    "JMP_" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens SDoc
    i
    mkFN_ :: SDoc -> SDoc
    mkFN_  SDoc
    i = String -> SDoc
    text String
    "FN_"  SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens SDoc
    i -- externally visible function
    mkIF_ :: SDoc -> SDoc
    mkIF_  SDoc
    i = String -> SDoc
    text String
    "IF_"  SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens SDoc
    i -- locally visible

    -- from includes/Stg.h
    --
    mkC_,mkW_,mkP_ :: SDoc

    mkC_ :: SDoc
    mkC_  = String -> SDoc
    text String
    "(C_)"        -- StgChar
    mkW_ :: SDoc
    mkW_  = String -> SDoc
    text String
    "(W_)"        -- StgWord
    mkP_ :: SDoc
    mkP_  = String -> SDoc
    text String
    "(P_)"        -- StgWord*

    -- ---------------------------------------------------------------------
    --
    -- Assignments
    --
    -- Generating assignments is what we're all about, here
    --
    pprAssign :: Platform -> CmmReg -> CmmExpr -> SDoc

    -- dest is a reg, rhs is a reg
    pprAssign :: Platform -> CmmReg -> CmmExpr -> SDoc
    pprAssign Platform
    _ CmmReg
    r1 (CmmReg CmmReg
    r2)
       | CmmReg -> Bool
    isPtrReg CmmReg
    r1 Bool -> Bool -> Bool
    && CmmReg -> Bool
    isPtrReg CmmReg
    r2
       = [SDoc] -> SDoc
    hcat [ CmmReg -> SDoc
    pprAsPtrReg CmmReg
    r1, SDoc
    equals, CmmReg -> SDoc
    pprAsPtrReg CmmReg
    r2, SDoc
    semi ]

    -- dest is a reg, rhs is a CmmRegOff
    pprAssign Platform
    platform CmmReg
    r1 (CmmRegOff CmmReg
    r2 Int
    off)
       | CmmReg -> Bool
    isPtrReg CmmReg
    r1 Bool -> Bool -> Bool
    && CmmReg -> Bool
    isPtrReg CmmReg
    r2 Bool -> Bool -> Bool
    && (Int
    off forall a. Integral a => a -> a -> a
    `rem` Platform -> Int
    platformWordSizeInBytes Platform
    platform forall a. Eq a => a -> a -> Bool
    == Int
    0)
       = [SDoc] -> SDoc
    hcat [ CmmReg -> SDoc
    pprAsPtrReg CmmReg
    r1, SDoc
    equals, CmmReg -> SDoc
    pprAsPtrReg CmmReg
    r2, SDoc
    op, Int -> SDoc
    int Int
    off', SDoc
    semi ]
      where
            off1 :: Int
    off1 = Int
    off forall a. Bits a => a -> Int -> a
    `shiftR` Platform -> Int
    wordShift Platform
    platform

            (SDoc
    op,Int
    off') | Int
    off forall a. Ord a => a -> a -> Bool
    >= Int
    0  = (Char -> SDoc
    char Char
    '+', Int
    off1)
                      | Bool
    otherwise = (Char -> SDoc
    char Char
    '-', -Int
    off1)

    -- dest is a reg, rhs is anything.
    -- We can't cast the lvalue, so we have to cast the rhs if necessary.  Casting
    -- the lvalue elicits a warning from new GCC versions (3.4+).
    pprAssign Platform
    platform CmmReg
    r1 CmmExpr
    r2
      | CmmReg -> Bool
    isFixedPtrReg CmmReg
    r1             = SDoc -> SDoc
    mkAssign (SDoc
    mkP_ SDoc -> SDoc -> SDoc
    <> Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    r2)
      | Just SDoc
    ty <- CmmReg -> Maybe SDoc
    strangeRegType CmmReg
    r1 = SDoc -> SDoc
    mkAssign (SDoc -> SDoc
    parens SDoc
    ty SDoc -> SDoc -> SDoc
    <> Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    r2)
      | Bool
    otherwise                    = SDoc -> SDoc
    mkAssign (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    r2)
        where mkAssign :: SDoc -> SDoc
    mkAssign SDoc
    x = if CmmReg
    r1 forall a. Eq a => a -> a -> Bool
    == GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    BaseReg
                           then String -> SDoc
    text String
    "ASSIGN_BaseReg" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens SDoc
    x SDoc -> SDoc -> SDoc
    <> SDoc
    semi
                           else CmmReg -> SDoc
    pprReg CmmReg
    r1 SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    " = " SDoc -> SDoc -> SDoc
    <> SDoc
    x SDoc -> SDoc -> SDoc
    <> SDoc
    semi

    -- ---------------------------------------------------------------------
    -- Registers

    pprCastReg :: CmmReg -> SDoc
    pprCastReg :: CmmReg -> SDoc
    pprCastReg CmmReg
    reg
       | CmmReg -> Bool
    isStrangeTypeReg CmmReg
    reg = SDoc
    mkW_ SDoc -> SDoc -> SDoc
    <> CmmReg -> SDoc
    pprReg CmmReg
    reg
       | Bool
    otherwise            = CmmReg -> SDoc
    pprReg CmmReg
    reg

    -- True if (pprReg reg) will give an expression with type StgPtr.  We
    -- need to take care with pointer arithmetic on registers with type
    -- StgPtr.
    isFixedPtrReg :: CmmReg -> Bool
    isFixedPtrReg :: CmmReg -> Bool
    isFixedPtrReg (CmmLocal LocalReg
    _) = Bool
    False
    isFixedPtrReg (CmmGlobal GlobalReg
    r) = GlobalReg -> Bool
    isFixedPtrGlobalReg GlobalReg
    r

    -- True if (pprAsPtrReg reg) will give an expression with type StgPtr
    -- JD: THIS IS HORRIBLE AND SHOULD BE RENAMED, AT THE VERY LEAST.
    -- THE GARBAGE WITH THE VNonGcPtr HELPS MATCH THE OLD CODE GENERATOR'S OUTPUT;
    -- I'M NOT SURE IF IT SHOULD REALLY STAY THAT WAY.
    isPtrReg :: CmmReg -> Bool
    isPtrReg :: CmmReg -> Bool
    isPtrReg (CmmLocal LocalReg
    _)                         = Bool
    False
    isPtrReg (CmmGlobal (VanillaReg Int
    _ VGcPtr
    VGcPtr))    = Bool
    True  -- if we print via pprAsPtrReg
    isPtrReg (CmmGlobal (VanillaReg Int
    _ VGcPtr
    VNonGcPtr)) = Bool
    False -- if we print via pprAsPtrReg
    isPtrReg (CmmGlobal GlobalReg
    reg)                      = GlobalReg -> Bool
    isFixedPtrGlobalReg GlobalReg
    reg

    -- True if this global reg has type StgPtr
    isFixedPtrGlobalReg :: GlobalReg -> Bool
    isFixedPtrGlobalReg :: GlobalReg -> Bool
    isFixedPtrGlobalReg GlobalReg
    Sp    = Bool
    True
    isFixedPtrGlobalReg GlobalReg
    Hp    = Bool
    True
    isFixedPtrGlobalReg GlobalReg
    HpLim = Bool
    True
    isFixedPtrGlobalReg GlobalReg
    SpLim = Bool
    True
    isFixedPtrGlobalReg GlobalReg
    _     = Bool
    False

    -- True if in C this register doesn't have the type given by
    -- (machRepCType (cmmRegType reg)), so it has to be cast.
    isStrangeTypeReg :: CmmReg -> Bool
    isStrangeTypeReg :: CmmReg -> Bool
    isStrangeTypeReg (CmmLocal LocalReg
    _)   = Bool
    False
    isStrangeTypeReg (CmmGlobal GlobalReg
    g)  = GlobalReg -> Bool
    isStrangeTypeGlobal GlobalReg
    g

    isStrangeTypeGlobal :: GlobalReg -> Bool
    isStrangeTypeGlobal :: GlobalReg -> Bool
    isStrangeTypeGlobal GlobalReg
    CCCS                = Bool
    True
    isStrangeTypeGlobal GlobalReg
    CurrentTSO          = Bool
    True
    isStrangeTypeGlobal GlobalReg
    CurrentNursery      = Bool
    True
    isStrangeTypeGlobal GlobalReg
    BaseReg             = Bool
    True
    isStrangeTypeGlobal GlobalReg
    r                   = GlobalReg -> Bool
    isFixedPtrGlobalReg GlobalReg
    r

    strangeRegType :: CmmReg -> Maybe SDoc
    strangeRegType :: CmmReg -> Maybe SDoc
    strangeRegType (CmmGlobal GlobalReg
    CCCS) = forall a. a -> Maybe a
    Just (String -> SDoc
    text String
    "struct CostCentreStack_ *")
    strangeRegType (CmmGlobal GlobalReg
    CurrentTSO) = forall a. a -> Maybe a
    Just (String -> SDoc
    text String
    "struct StgTSO_ *")
    strangeRegType (CmmGlobal GlobalReg
    CurrentNursery) = forall a. a -> Maybe a
    Just (String -> SDoc
    text String
    "struct bdescr_ *")
    strangeRegType (CmmGlobal GlobalReg
    BaseReg) = forall a. a -> Maybe a
    Just (String -> SDoc
    text String
    "struct StgRegTable_ *")
    strangeRegType CmmReg
    _ = forall a. Maybe a
    Nothing

    -- pprReg just prints the register name.
    --
    pprReg :: CmmReg -> SDoc
    pprReg :: CmmReg -> SDoc
    pprReg CmmReg
    r = case CmmReg
    r of
            CmmLocal  LocalReg
    local  -> LocalReg -> SDoc
    pprLocalReg LocalReg
    local
            CmmGlobal GlobalReg
    global -> GlobalReg -> SDoc
    pprGlobalReg GlobalReg
    global

    pprAsPtrReg :: CmmReg -> SDoc
    pprAsPtrReg :: CmmReg -> SDoc
    pprAsPtrReg (CmmGlobal (VanillaReg Int
    n VGcPtr
    gcp))
      = WARN( gcp /= VGcPtr, ppr n ) char 'R' <> int n <> text ".p"
    pprAsPtrReg CmmReg
    other_reg = CmmReg -> SDoc
    pprReg CmmReg
    other_reg

    pprGlobalReg :: GlobalReg -> SDoc
    pprGlobalReg :: GlobalReg -> SDoc
    pprGlobalReg GlobalReg
    gr = case GlobalReg
    gr of
        VanillaReg Int
    n VGcPtr
    _ -> Char -> SDoc
    char Char
    'R' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    n  SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ".w"
            -- pprGlobalReg prints a VanillaReg as a .w regardless
            -- Example:     R1.w = R1.w & (-0x8UL);
            --              JMP_(*R1.p);
        FloatReg   Int
    n   -> Char -> SDoc
    char Char
    'F' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    n
        DoubleReg  Int
    n   -> Char -> SDoc
    char Char
    'D' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    n
        LongReg    Int
    n   -> Char -> SDoc
    char Char
    'L' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    n
        GlobalReg
    Sp             -> String -> SDoc
    text String
    "Sp"
        GlobalReg
    SpLim          -> String -> SDoc
    text String
    "SpLim"
        GlobalReg
    Hp             -> String -> SDoc
    text String
    "Hp"
        GlobalReg
    HpLim          -> String -> SDoc
    text String
    "HpLim"
        GlobalReg
    CCCS           -> String -> SDoc
    text String
    "CCCS"
        GlobalReg
    CurrentTSO     -> String -> SDoc
    text String
    "CurrentTSO"
        GlobalReg
    CurrentNursery -> String -> SDoc
    text String
    "CurrentNursery"
        GlobalReg
    HpAlloc        -> String -> SDoc
    text String
    "HpAlloc"
        GlobalReg
    BaseReg        -> String -> SDoc
    text String
    "BaseReg"
        GlobalReg
    EagerBlackholeInfo -> String -> SDoc
    text String
    "stg_EAGER_BLACKHOLE_info"
        GlobalReg
    GCEnter1       -> String -> SDoc
    text String
    "stg_gc_enter_1"
        GlobalReg
    GCFun          -> String -> SDoc
    text String
    "stg_gc_fun"
        GlobalReg
    other          -> forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "pprGlobalReg: Unsupported register: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show GlobalReg
    other

    pprLocalReg :: LocalReg -> SDoc
    pprLocalReg :: LocalReg -> SDoc
    pprLocalReg (LocalReg Unique
    uniq CmmType
    _) = Char -> SDoc
    char Char
    '_' SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Unique
    uniq

    -- -----------------------------------------------------------------------------
    -- Foreign Calls

    pprCall :: Platform -> SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc
    pprCall :: Platform
    -> SDoc
    -> CCallConv
    -> [(LocalReg, ForeignHint)]
    -> [(CmmExpr, ForeignHint)]
    -> SDoc
    pprCall Platform
    platform SDoc
    ppr_fn CCallConv
    cconv [(LocalReg, ForeignHint)]
    results [(CmmExpr, ForeignHint)]
    args
      | Bool -> Bool
    not (CCallConv -> Bool
    is_cishCC CCallConv
    cconv)
      = forall a. String -> a
    panic forall a b. (a -> b) -> a -> b
    $ String
    "pprCall: unknown calling convention"

      | Bool
    otherwise
      =
        [(LocalReg, ForeignHint)] -> SDoc -> SDoc
    ppr_assign [(LocalReg, ForeignHint)]
    results (SDoc
    ppr_fn SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens ([SDoc] -> SDoc
    commafy (forall a b. (a -> b) -> [a] -> [b]
    map (CmmExpr, ForeignHint) -> SDoc
    pprArg [(CmmExpr, ForeignHint)]
    args))) SDoc -> SDoc -> SDoc
    <> SDoc
    semi
      where
         ppr_assign :: [(LocalReg, ForeignHint)] -> SDoc -> SDoc
    ppr_assign []           SDoc
    rhs = SDoc
    rhs
         ppr_assign [(LocalReg
    one,ForeignHint
    hint)] SDoc
    rhs
             = LocalReg -> SDoc
    pprLocalReg LocalReg
    one SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    " = "
                     SDoc -> SDoc -> SDoc
    <> ForeignHint -> CmmType -> SDoc
    pprUnHint ForeignHint
    hint (LocalReg -> CmmType
    localRegType LocalReg
    one) SDoc -> SDoc -> SDoc
    <> SDoc
    rhs
         ppr_assign [(LocalReg, ForeignHint)]
    _other SDoc
    _rhs = forall a. String -> a
    panic String
    "pprCall: multiple results"

         pprArg :: (CmmExpr, ForeignHint) -> SDoc
    pprArg (CmmExpr
    expr, ForeignHint
    AddrHint)
            = Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform (String -> SDoc
    text String
    "void *") CmmExpr
    expr
            -- see comment by machRepHintCType below
         pprArg (CmmExpr
    expr, ForeignHint
    SignedHint)
            = Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform (Platform -> Width -> SDoc
    machRep_S_CType Platform
    platform forall a b. (a -> b) -> a -> b
    $ CmmType -> Width
    typeWidth forall a b. (a -> b) -> a -> b
    $ Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    expr) CmmExpr
    expr
         pprArg (CmmExpr
    expr, ForeignHint
    _other)
            = Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    expr

         pprUnHint :: ForeignHint -> CmmType -> SDoc
    pprUnHint ForeignHint
    AddrHint   CmmType
    rep = SDoc -> SDoc
    parens (Platform -> CmmType -> SDoc
    machRepCType Platform
    platform CmmType
    rep)
         pprUnHint ForeignHint
    SignedHint CmmType
    rep = SDoc -> SDoc
    parens (Platform -> CmmType -> SDoc
    machRepCType Platform
    platform CmmType
    rep)
         pprUnHint ForeignHint
    _          CmmType
    _   = SDoc
    empty

    -- Currently we only have these two calling conventions, but this might
    -- change in the future...
    is_cishCC :: CCallConv -> Bool
    is_cishCC :: CCallConv -> Bool
    is_cishCC CCallConv
    CCallConv    = Bool
    True
    is_cishCC CCallConv
    CApiConv     = Bool
    True
    is_cishCC CCallConv
    StdCallConv  = Bool
    True
    is_cishCC CCallConv
    PrimCallConv = Bool
    False
    is_cishCC CCallConv
    JavaScriptCallConv = Bool
    False

    -- ---------------------------------------------------------------------
    -- Find and print local and external declarations for a list of
    -- Cmm statements.
    --
    pprTempAndExternDecls :: Platform -> [CmmBlock] -> (SDoc{-temps-}, SDoc{-externs-})
    pprTempAndExternDecls :: Platform -> [CmmBlock] -> (SDoc, SDoc)
    pprTempAndExternDecls Platform
    platform [CmmBlock]
    stmts
      = (forall key a. UniqFM key a -> ([a] -> SDoc) -> SDoc
    pprUFM (forall a. UniqSet a -> UniqFM a a
    getUniqSet UniqSet LocalReg
    temps) ([SDoc] -> SDoc
    vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> LocalReg -> SDoc
    pprTempDecl Platform
    platform)),
         [SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CLabel -> SDoc
    pprExternDecl Platform
    platform) (forall k a. Map k a -> [k]
    Map.keys Map CLabel ()
    lbls)))
      where (UniqSet LocalReg
    temps, Map CLabel ()
    lbls) = TE () -> (UniqSet LocalReg, Map CLabel ())
    runTE (forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ CmmBlock -> TE ()
    te_BB [CmmBlock]
    stmts)

    pprDataExterns :: Platform -> [CmmStatic] -> SDoc
    pprDataExterns :: Platform -> [CmmStatic] -> SDoc
    pprDataExterns Platform
    platform [CmmStatic]
    statics
      = [SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CLabel -> SDoc
    pprExternDecl Platform
    platform) (forall k a. Map k a -> [k]
    Map.keys Map CLabel ()
    lbls))
      where (UniqSet LocalReg
    _, Map CLabel ()
    lbls) = TE () -> (UniqSet LocalReg, Map CLabel ())
    runTE (forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ CmmStatic -> TE ()
    te_Static [CmmStatic]
    statics)

    pprTempDecl :: Platform -> LocalReg -> SDoc
    pprTempDecl :: Platform -> LocalReg -> SDoc
    pprTempDecl Platform
    platform l :: LocalReg
    l@(LocalReg Unique
    _ CmmType
    rep)
      = [SDoc] -> SDoc
    hcat [ Platform -> CmmType -> SDoc
    machRepCType Platform
    platform CmmType
    rep, SDoc
    space, LocalReg -> SDoc
    pprLocalReg LocalReg
    l, SDoc
    semi ]

    pprExternDecl :: Platform -> CLabel -> SDoc
    pprExternDecl :: Platform -> CLabel -> SDoc
    pprExternDecl Platform
    platform CLabel
    lbl
      -- do not print anything for "known external" things
      | Bool -> Bool
    not (CLabel -> Bool
    needsCDecl CLabel
    lbl) = SDoc
    empty
      | Just Int
    sz <- CLabel -> Maybe Int
    foreignLabelStdcallInfo CLabel
    lbl = Int -> SDoc
    stdcall_decl Int
    sz
      | Bool
    otherwise =
            [SDoc] -> SDoc
    hcat [ SDoc
    visibility, CLabel -> SDoc
    label_type CLabel
    lbl , SDoc
    lparen, Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl, String -> SDoc
    text String
    ");"
                 -- occasionally useful to see label type
                 -- , text "/* ", pprDebugCLabel lbl, text " */"
                 ]
     where
      label_type :: CLabel -> SDoc
    label_type CLabel
    lbl | CLabel -> Bool
    isBytesLabel CLabel
    lbl         = String -> SDoc
    text String
    "B_"
                     | CLabel -> Bool
    isForeignLabel CLabel
    lbl Bool -> Bool -> Bool
    && CLabel -> Bool
    isCFunctionLabel CLabel
    lbl
                                                = String -> SDoc
    text String
    "FF_"
                     | CLabel -> Bool
    isCFunctionLabel CLabel
    lbl     = String -> SDoc
    text String
    "F_"
                     | CLabel -> Bool
    isStaticClosureLabel CLabel
    lbl = String -> SDoc
    text String
    "C_"
                     -- generic .rodata labels
                     | CLabel -> Bool
    isSomeRODataLabel CLabel
    lbl    = String -> SDoc
    text String
    "RO_"
                     -- generic .data labels (common case)
                     | Bool
    otherwise                = String -> SDoc
    text String
    "RW_"

      visibility :: SDoc
    visibility
         | CLabel -> Bool
    externallyVisibleCLabel CLabel
    lbl = Char -> SDoc
    char Char
    'E'
         | Bool
    otherwise                   = Char -> SDoc
    char Char
    'I'

      -- If the label we want to refer to is a stdcall function (on Windows) then
      -- we must generate an appropriate prototype for it, so that the C compiler will
      -- add the @n suffix to the label (#2276)
      stdcall_decl :: Int -> SDoc
    stdcall_decl Int
    sz =
            String -> SDoc
    text String
    "extern __attribute__((stdcall)) void " SDoc -> SDoc -> SDoc
    <> Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    lbl
            SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens ([SDoc] -> SDoc
    commafy (forall a. Int -> a -> [a]
    replicate (Int
    sz forall a. Integral a => a -> a -> a
    `quot` Platform -> Int
    platformWordSizeInBytes Platform
    platform) (Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform (Platform -> Width
    wordWidth Platform
    platform))))
            SDoc -> SDoc -> SDoc
    <> SDoc
    semi

    type TEState = (UniqSet LocalReg, Map CLabel ())
    newtype TE a = TE { forall a.
    TE a
    -> (UniqSet LocalReg, Map CLabel ())
    -> (a, (UniqSet LocalReg, Map CLabel ()))
    unTE :: TEState -> (a, TEState) } deriving (forall a b. a -> TE b -> TE a
    forall a b. (a -> b) -> TE a -> TE b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> TE b -> TE a
    $c<$ :: forall a b. a -> TE b -> TE a
    fmap :: forall a b. (a -> b) -> TE a -> TE b
    $cfmap :: forall a b. (a -> b) -> TE a -> TE b
    Functor)

    instance Applicative TE where
          pure :: forall a. a -> TE a
    pure a
    a = forall a.
    ((UniqSet LocalReg, Map CLabel ())
     -> (a, (UniqSet LocalReg, Map CLabel ())))
    -> TE a
    TE forall a b. (a -> b) -> a -> b
    $ \(UniqSet LocalReg, Map CLabel ())
    s -> (a
    a, (UniqSet LocalReg, Map CLabel ())
    s)
          <*> :: forall a b. TE (a -> b) -> TE a -> TE b
    (<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad TE where
       TE (UniqSet LocalReg, Map CLabel ())
    -> (a, (UniqSet LocalReg, Map CLabel ()))
    m >>= :: forall a b. TE a -> (a -> TE b) -> TE b
    >>= a -> TE b
    k  = forall a.
    ((UniqSet LocalReg, Map CLabel ())
     -> (a, (UniqSet LocalReg, Map CLabel ())))
    -> TE a
    TE forall a b. (a -> b) -> a -> b
    $ \(UniqSet LocalReg, Map CLabel ())
    s -> case (UniqSet LocalReg, Map CLabel ())
    -> (a, (UniqSet LocalReg, Map CLabel ()))
    m (UniqSet LocalReg, Map CLabel ())
    s of (a
    a, (UniqSet LocalReg, Map CLabel ())
    s') -> forall a.
    TE a
    -> (UniqSet LocalReg, Map CLabel ())
    -> (a, (UniqSet LocalReg, Map CLabel ()))
    unTE (a -> TE b
    k a
    a) (UniqSet LocalReg, Map CLabel ())
    s'

    te_lbl :: CLabel -> TE ()
    te_lbl :: CLabel -> TE ()
    te_lbl CLabel
    lbl = forall a.
    ((UniqSet LocalReg, Map CLabel ())
     -> (a, (UniqSet LocalReg, Map CLabel ())))
    -> TE a
    TE forall a b. (a -> b) -> a -> b
    $ \(UniqSet LocalReg
    temps,Map CLabel ()
    lbls) -> ((), (UniqSet LocalReg
    temps, forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert CLabel
    lbl () Map CLabel ()
    lbls))

    te_temp :: LocalReg -> TE ()
    te_temp :: LocalReg -> TE ()
    te_temp LocalReg
    r = forall a.
    ((UniqSet LocalReg, Map CLabel ())
     -> (a, (UniqSet LocalReg, Map CLabel ())))
    -> TE a
    TE forall a b. (a -> b) -> a -> b
    $ \(UniqSet LocalReg
    temps,Map CLabel ()
    lbls) -> ((), (forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet UniqSet LocalReg
    temps LocalReg
    r, Map CLabel ()
    lbls))

    runTE :: TE () -> TEState
    runTE :: TE () -> (UniqSet LocalReg, Map CLabel ())
    runTE (TE (UniqSet LocalReg, Map CLabel ())
    -> ((), (UniqSet LocalReg, Map CLabel ()))
    m) = forall a b. (a, b) -> b
    snd ((UniqSet LocalReg, Map CLabel ())
    -> ((), (UniqSet LocalReg, Map CLabel ()))
    m (forall a. UniqSet a
    emptyUniqSet, forall k a. Map k a
    Map.empty))

    te_Static :: CmmStatic -> TE ()
    te_Static :: CmmStatic -> TE ()
    te_Static (CmmStaticLit CmmLit
    lit) = CmmLit -> TE ()
    te_Lit CmmLit
    lit
    te_Static CmmStatic
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    te_BB :: CmmBlock -> TE ()
    te_BB :: CmmBlock -> TE ()
    te_BB CmmBlock
    block = forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> TE ()
    te_Stmt (forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    mid) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> TE ()
    te_Stmt CmmNode O C
    last
      where (CmmNode C O
    _, Block CmmNode O O
    mid, CmmNode O C
    last) = forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    block

    te_Lit :: CmmLit -> TE ()
    te_Lit :: CmmLit -> TE ()
    te_Lit (CmmLabel CLabel
    l) = CLabel -> TE ()
    te_lbl CLabel
    l
    te_Lit (CmmLabelOff CLabel
    l Int
    _) = CLabel -> TE ()
    te_lbl CLabel
    l
    te_Lit (CmmLabelDiffOff CLabel
    l1 CLabel
    _ Int
    _ Width
    _) = CLabel -> TE ()
    te_lbl CLabel
    l1
    te_Lit CmmLit
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    te_Stmt :: CmmNode e x -> TE ()
    te_Stmt :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> TE ()
    te_Stmt (CmmAssign CmmReg
    r CmmExpr
    e)         = CmmReg -> TE ()
    te_Reg CmmReg
    r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> CmmExpr -> TE ()
    te_Expr CmmExpr
    e
    te_Stmt (CmmStore CmmExpr
    l CmmExpr
    r AlignmentSpec
    _)        = CmmExpr -> TE ()
    te_Expr CmmExpr
    l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> CmmExpr -> TE ()
    te_Expr CmmExpr
    r
    te_Stmt (CmmUnsafeForeignCall ForeignTarget
    target [LocalReg]
    rs [CmmExpr]
    es)
      = do  ForeignTarget -> TE ()
    te_Target ForeignTarget
    target
            forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ LocalReg -> TE ()
    te_temp [LocalReg]
    rs
            forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ CmmExpr -> TE ()
    te_Expr [CmmExpr]
    es
    te_Stmt (CmmCondBranch CmmExpr
    e BlockId
    _ BlockId
    _ Maybe Bool
    _) = CmmExpr -> TE ()
    te_Expr CmmExpr
    e
    te_Stmt (CmmSwitch CmmExpr
    e SwitchTargets
    _)         = CmmExpr -> TE ()
    te_Expr CmmExpr
    e
    te_Stmt (CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    e }) = CmmExpr -> TE ()
    te_Expr CmmExpr
    e
    te_Stmt CmmNode e x
    _                       = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    te_Target :: ForeignTarget -> TE ()
    te_Target :: ForeignTarget -> TE ()
    te_Target (ForeignTarget CmmExpr
    e ForeignConvention
    _)      = CmmExpr -> TE ()
    te_Expr CmmExpr
    e
    te_Target (PrimTarget{})           = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    te_Expr :: CmmExpr -> TE ()
    te_Expr :: CmmExpr -> TE ()
    te_Expr (CmmLit CmmLit
    lit)            = CmmLit -> TE ()
    te_Lit CmmLit
    lit
    te_Expr (CmmLoad CmmExpr
    e CmmType
    _ AlignmentSpec
    _)         = CmmExpr -> TE ()
    te_Expr CmmExpr
    e
    te_Expr (CmmReg CmmReg
    r)              = CmmReg -> TE ()
    te_Reg CmmReg
    r
    te_Expr (CmmMachOp MachOp
    _ [CmmExpr]
    es)        = forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ CmmExpr -> TE ()
    te_Expr [CmmExpr]
    es
    te_Expr (CmmRegOff CmmReg
    r Int
    _)         = CmmReg -> TE ()
    te_Reg CmmReg
    r
    te_Expr (CmmStackSlot Area
    _ Int
    _)      = forall a. String -> a
    panic String
    "te_Expr: CmmStackSlot not supported!"

    te_Reg :: CmmReg -> TE ()
    te_Reg :: CmmReg -> TE ()
    te_Reg (CmmLocal LocalReg
    l) = LocalReg -> TE ()
    te_temp LocalReg
    l
    te_Reg CmmReg
    _            = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- ---------------------------------------------------------------------
    -- C types for MachReps

    cCast :: Platform -> SDoc -> CmmExpr -> SDoc
    cCast :: Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform SDoc
    ty CmmExpr
    expr = SDoc -> SDoc
    parens SDoc
    ty SDoc -> SDoc -> SDoc
    <> Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    expr

    cLoad :: Platform -> CmmExpr -> CmmType -> SDoc
    cLoad :: Platform -> CmmExpr -> CmmType -> SDoc
    cLoad Platform
    platform CmmExpr
    expr CmmType
    rep
        = if Arch -> Bool
    bewareLoadStoreAlignment (Platform -> Arch
    platformArch Platform
    platform)
          then let decl :: SDoc
    decl = Platform -> CmmType -> SDoc
    machRepCType Platform
    platform CmmType
    rep SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "x" SDoc -> SDoc -> SDoc
    <> SDoc
    semi
                   struct :: SDoc
    struct = String -> SDoc
    text String
    "struct" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    braces (SDoc
    decl)
                   packed_attr :: SDoc
    packed_attr = String -> SDoc
    text String
    "__attribute__((packed))"
                   cast :: SDoc
    cast = SDoc -> SDoc
    parens (SDoc
    struct SDoc -> SDoc -> SDoc
    <+> SDoc
    packed_attr SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '*')
               in SDoc -> SDoc
    parens (SDoc
    cast SDoc -> SDoc -> SDoc
    <+> Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    expr) SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "->x"
          else Char -> SDoc
    char Char
    '*' SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens (Platform -> SDoc -> CmmExpr -> SDoc
    cCast Platform
    platform (Platform -> CmmType -> SDoc
    machRepPtrCType Platform
    platform CmmType
    rep) CmmExpr
    expr)
        where -- On these platforms, unaligned loads are known to cause problems
              bewareLoadStoreAlignment :: Arch -> Bool
    bewareLoadStoreAlignment Arch
    ArchAlpha    = Bool
    True
              bewareLoadStoreAlignment Arch
    ArchMipseb   = Bool
    True
              bewareLoadStoreAlignment Arch
    ArchMipsel   = Bool
    True
              bewareLoadStoreAlignment (ArchARM {}) = Bool
    True
              bewareLoadStoreAlignment Arch
    ArchAArch64  = Bool
    True
              bewareLoadStoreAlignment Arch
    ArchSPARC    = Bool
    True
              bewareLoadStoreAlignment Arch
    ArchSPARC64  = Bool
    True
              -- Pessimistically assume that they will also cause problems
              -- on unknown arches
              bewareLoadStoreAlignment Arch
    ArchUnknown  = Bool
    True
              bewareLoadStoreAlignment Arch
    _            = Bool
    False

    isCmmWordType :: Platform -> CmmType -> Bool
    -- True of GcPtrReg/NonGcReg of native word size
    isCmmWordType :: Platform -> CmmType -> Bool
    isCmmWordType Platform
    platform CmmType
    ty = Bool -> Bool
    not (CmmType -> Bool
    isFloatType CmmType
    ty)
                                Bool -> Bool -> Bool
    && CmmType -> Width
    typeWidth CmmType
    ty forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform

    -- This is for finding the types of foreign call arguments.  For a pointer
    -- argument, we always cast the argument to (void *), to avoid warnings from
    -- the C compiler.
    machRepHintCType :: Platform -> CmmType -> ForeignHint -> SDoc
    machRepHintCType :: Platform -> CmmType -> ForeignHint -> SDoc
    machRepHintCType Platform
    platform CmmType
    rep = \case
       ForeignHint
    AddrHint   -> String -> SDoc
    text String
    "void *"
       ForeignHint
    SignedHint -> Platform -> Width -> SDoc
    machRep_S_CType Platform
    platform (CmmType -> Width
    typeWidth CmmType
    rep)
       ForeignHint
    _other     -> Platform -> CmmType -> SDoc
    machRepCType Platform
    platform CmmType
    rep

    machRepPtrCType :: Platform -> CmmType -> SDoc
    machRepPtrCType :: Platform -> CmmType -> SDoc
    machRepPtrCType Platform
    platform CmmType
    r
     = if Platform -> CmmType -> Bool
    isCmmWordType Platform
    platform CmmType
    r
          then String -> SDoc
    text String
    "P_"
          else Platform -> CmmType -> SDoc
    machRepCType Platform
    platform CmmType
    r SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '*'

    machRepCType :: Platform -> CmmType -> SDoc
    machRepCType :: Platform -> CmmType -> SDoc
    machRepCType Platform
    platform CmmType
    ty
       | CmmType -> Bool
    isFloatType CmmType
    ty = Width -> SDoc
    machRep_F_CType Width
    w
       | Bool
    otherwise      = Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform Width
    w
       where
          w :: Width
    w = CmmType -> Width
    typeWidth CmmType
    ty

    machRep_F_CType :: Width -> SDoc
    machRep_F_CType :: Width -> SDoc
    machRep_F_CType Width
    W32 = String -> SDoc
    text String
    "StgFloat" -- ToDo: correct?
    machRep_F_CType Width
    W64 = String -> SDoc
    text String
    "StgDouble"
    machRep_F_CType Width
    _   = forall a. String -> a
    panic String
    "machRep_F_CType"

    machRep_U_CType :: Platform -> Width -> SDoc
    machRep_U_CType :: Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform Width
    w
     = case Width
    w of
       Width
    _ | Width
    w forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform -> String -> SDoc
    text String
    "W_"
       Width
    W8  -> String -> SDoc
    text String
    "StgWord8"
       Width
    W16 -> String -> SDoc
    text String
    "StgWord16"
       Width
    W32 -> String -> SDoc
    text String
    "StgWord32"
       Width
    W64 -> String -> SDoc
    text String
    "StgWord64"
       Width
    _   -> forall a. String -> a
    panic String
    "machRep_U_CType"

    machRep_S_CType :: Platform -> Width -> SDoc
    machRep_S_CType :: Platform -> Width -> SDoc
    machRep_S_CType Platform
    platform Width
    w
     = case Width
    w of
       Width
    _ | Width
    w forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform -> String -> SDoc
    text String
    "I_"
       Width
    W8  -> String -> SDoc
    text String
    "StgInt8"
       Width
    W16 -> String -> SDoc
    text String
    "StgInt16"
       Width
    W32 -> String -> SDoc
    text String
    "StgInt32"
       Width
    W64 -> String -> SDoc
    text String
    "StgInt64"
       Width
    _   -> forall a. String -> a
    panic String
    "machRep_S_CType"

    -- ---------------------------------------------------------------------
    -- print strings as valid C strings

    pprStringInCStyle :: ByteString -> SDoc
    pprStringInCStyle :: ByteString -> SDoc
    pprStringInCStyle ByteString
    s = SDoc -> SDoc
    doubleQuotes (String -> SDoc
    text (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Word8 -> String
    charToC (ByteString -> [Word8]
    BS.unpack ByteString
    s)))

    -- ---------------------------------------------------------------------------
    -- Initialising static objects with floating-point numbers.  We can't
    -- just emit the floating point number, because C will cast it to an int
    -- by rounding it.  We want the actual bit-representation of the float.
    --
    -- Consider a concrete C example:
    --    double d = 2.5e-10;
    --    float f  = 2.5e-10f;
    --
    --    int * i2 = &d;      printf ("i2: %08X %08X\n", i2[0], i2[1]);
    --    long long * l = &d; printf (" l: %016llX\n",   l[0]);
    --    int * i = &f;       printf (" i: %08X\n",      i[0]);
    -- Result on 64-bit LE (x86_64):
    --     i2: E826D695 3DF12E0B
    --      l: 3DF12E0BE826D695
    --      i: 2F89705F
    -- Result on 32-bit BE (m68k):
    --     i2: 3DF12E0B E826D695
    --      l: 3DF12E0BE826D695
    --      i: 2F89705F
    --
    -- The trick here is to notice that binary representation does not
    -- change much: only Word32 values get swapped on LE hosts / targets.

    -- This is a hack to turn the floating point numbers into ints that we
    -- can safely initialise to static locations.

    floatToWord32 :: Rational -> CmmLit
    floatToWord32 :: Rational -> CmmLit
    floatToWord32 Rational
    r
      = forall a. (forall s. ST s a) -> a
    runST forall a b. (a -> b) -> a -> b
    $ do
            STUArray s Int Float
    arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ ((Int
    0::Int),Int
    0)
            forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Float
    arr Int
    0 (forall a. Fractional a => Rational -> a
    fromRational Rational
    r)
            STUArray s Int Word32
    arr' <- forall s. STUArray s Int Float -> ST s (STUArray s Int Word32)
    castFloatToWord32Array STUArray s Int Float
    arr
            Word32
    w32 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word32
    arr' Int
    0
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Width -> CmmLit
    CmmInt (forall a. Integral a => a -> Integer
    toInteger Word32
    w32) Width
    W32)
      where
        castFloatToWord32Array :: STUArray s Int Float -> ST s (STUArray s Int Word32)
        castFloatToWord32Array :: forall s. STUArray s Int Float -> ST s (STUArray s Int Word32)
    castFloatToWord32Array = forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    U.castSTUArray

    doubleToWord64 :: Rational -> CmmLit
    doubleToWord64 :: Rational -> CmmLit
    doubleToWord64 Rational
    r
      = forall a. (forall s. ST s a) -> a
    runST forall a b. (a -> b) -> a -> b
    $ do
            STUArray s Int Double
    arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ ((Int
    0::Int),Int
    1)
            forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Double
    arr Int
    0 (forall a. Fractional a => Rational -> a
    fromRational Rational
    r)
            STUArray s Int Word64
    arr' <- forall s. STUArray s Int Double -> ST s (STUArray s Int Word64)
    castDoubleToWord64Array STUArray s Int Double
    arr
            Word64
    w64 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word64
    arr' Int
    0
            forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Integer -> Width -> CmmLit
    CmmInt (forall a. Integral a => a -> Integer
    toInteger Word64
    w64) Width
    W64
      where
        castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
        castDoubleToWord64Array :: forall s. STUArray s Int Double -> ST s (STUArray s Int Word64)
    castDoubleToWord64Array = forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    U.castSTUArray

    -- ---------------------------------------------------------------------------
    -- Utils

    wordShift :: Platform -> Int
    wordShift :: Platform -> Int
    wordShift Platform
    platform = Width -> Int
    widthInLog (Platform -> Width
    wordWidth Platform
    platform)

    commafy :: [SDoc] -> SDoc
    commafy :: [SDoc] -> SDoc
    commafy [SDoc]
    xs = [SDoc] -> SDoc
    hsep forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma [SDoc]
    xs

    -- | Print in C hex format
    --
    -- Examples:
    --
    --   5114    :: W32  ===>  ((StgWord32)0x13faU)
    --   (-5114) :: W32  ===>  ((StgWord32)(-0x13faU))
    --
    -- We use casts to support types smaller than `unsigned int`; C literal
    -- suffixes support longer but not shorter types.
    pprHexVal :: Platform -> Integer -> Width -> SDoc
    pprHexVal :: Platform -> Integer -> Width -> SDoc
    pprHexVal Platform
    platform Integer
    w Width
    rep = SDoc -> SDoc
    parens SDoc
    ctype SDoc -> SDoc -> SDoc
    <> SDoc
    rawlit
      where
          rawlit :: SDoc
    rawlit
            | Integer
    w forall a. Ord a => a -> a -> Bool
    < Integer
    0     = SDoc -> SDoc
    parens (Char -> SDoc
    char Char
    '-' SDoc -> SDoc -> SDoc
    <>
                              String -> SDoc
    text String
    "0x" SDoc -> SDoc -> SDoc
    <> Integer -> SDoc
    intToDoc (-Integer
    w) SDoc -> SDoc -> SDoc
    <> Width -> SDoc
    repsuffix Width
    rep)
            | Bool
    otherwise =     String -> SDoc
    text String
    "0x" SDoc -> SDoc -> SDoc
    <> Integer -> SDoc
    intToDoc   Integer
    w  SDoc -> SDoc -> SDoc
    <> Width -> SDoc
    repsuffix Width
    rep
          ctype :: SDoc
    ctype = Platform -> Width -> SDoc
    machRep_U_CType Platform
    platform Width
    rep

            -- type suffix for literals:
            -- Integer literals are unsigned in Cmm/C.  We explicitly cast to
            -- signed values for doing signed operations, but at all other
            -- times values are unsigned.  This also helps eliminate occasional
            -- warnings about integer overflow from gcc.

          constants :: PlatformConstants
    constants = Platform -> PlatformConstants
    platformConstants Platform
    platform

          repsuffix :: Width -> SDoc
    repsuffix Width
    W64 =
                   if PlatformConstants -> Int
    pc_CINT_SIZE       PlatformConstants
    constants forall a. Eq a => a -> a -> Bool
    == Int
    8 then Char -> SDoc
    char Char
    'U'
              else if PlatformConstants -> Int
    pc_CLONG_SIZE      PlatformConstants
    constants forall a. Eq a => a -> a -> Bool
    == Int
    8 then String -> SDoc
    text String
    "UL"
              else if PlatformConstants -> Int
    pc_CLONG_LONG_SIZE PlatformConstants
    constants forall a. Eq a => a -> a -> Bool
    == Int
    8 then String -> SDoc
    text String
    "ULL"
              else forall a. String -> a
    panic String
    "pprHexVal: Can't find a 64-bit type"
          repsuffix Width
    _ = Char -> SDoc
    char Char
    'U'

          intToDoc :: Integer -> SDoc
          intToDoc :: Integer -> SDoc
    intToDoc Integer
    i = case Integer -> Integer
    truncInt Integer
    i of
                           Integer
    0 -> Char -> SDoc
    char Char
    '0'
                           Integer
    v -> Integer -> SDoc
    go Integer
    v

          -- We need to truncate value as Cmm backend does not drop
          -- redundant bits to ease handling of negative values.
          -- Thus the following Cmm code on 64-bit arch, like amd64:
          --     CInt v;
          --     v = {something};
          --     if (v == %lobits32(-1)) { ...
          -- leads to the following C code:
          --     StgWord64 v = (StgWord32)({something});
          --     if (v == 0xFFFFffffFFFFffffU) { ...
          -- Such code is incorrect as it promotes both operands to StgWord64
          -- and the whole condition is always false.
          truncInt :: Integer -> Integer
          truncInt :: Integer -> Integer
    truncInt Integer
    i =
              case Width
    rep of
                  Width
    W8  -> Integer
    i forall a. Integral a => a -> a -> a
    `rem` (Integer
    2forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    8 :: Int))
                  Width
    W16 -> Integer
    i forall a. Integral a => a -> a -> a
    `rem` (Integer
    2forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    16 :: Int))
                  Width
    W32 -> Integer
    i forall a. Integral a => a -> a -> a
    `rem` (Integer
    2forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    32 :: Int))
                  Width
    W64 -> Integer
    i forall a. Integral a => a -> a -> a
    `rem` (Integer
    2forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    64 :: Int))
                  Width
    _   -> forall a. String -> a
    panic (String
    "pprHexVal/truncInt: C backend can't encode "
                                forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show Width
    rep forall a. [a] -> [a] -> [a]
    ++ String
    " literals")

          go :: Integer -> SDoc
    go Integer
    0 = SDoc
    empty
          go Integer
    w' = Integer -> SDoc
    go Integer
    q SDoc -> SDoc -> SDoc
    <> SDoc
    dig
               where
                 (Integer
    q,Integer
    r) = Integer
    w' forall a. Integral a => a -> a -> (a, a)
    `quotRem` Integer
    16
                 dig :: SDoc
    dig | Integer
    r forall a. Ord a => a -> a -> Bool
    < Integer
    10    = Char -> SDoc
    char (Int -> Char
    chr (forall a. Num a => Integer -> a
    fromInteger Integer
    r forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    '0'))
                     | Bool
    otherwise = Char -> SDoc
    char (Int -> Char
    chr (forall a. Num a => Integer -> a
    fromInteger Integer
    r forall a. Num a => a -> a -> a
    - Int
    10 forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    'a'))