    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE UndecidableInstances #-}

    module GHC.Cmm.Expr
        ( CmmExpr(..), cmmExprType, cmmExprWidth, cmmExprAlignment, maybeInvertCmmExpr
        , CmmReg(..), cmmRegType, cmmRegWidth
        , CmmLit(..), cmmLitType
        , AlignmentSpec(..)
          -- TODO: Remove:
        , LocalReg(..), localRegType
        , GlobalReg(..), isArgReg, globalRegType
        , spReg, hpReg, spLimReg, hpLimReg, nodeReg
        , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
        , node, baseReg
        , VGcPtr(..)

        , DefinerOfRegs, UserOfRegs
        , foldRegsDefd, foldRegsUsed
        , foldLocalRegsDefd, foldLocalRegsUsed

        , RegSet, LocalRegSet, GlobalRegSet
        , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
        , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
        , regSetToList

        , isTrivialCmmExpr
        , hasNoGlobalRegs
        , isLit
        , isComparisonExpr

        , Area(..)
        , module GHC.Cmm.MachOp
        , module GHC.Cmm.Type
        )
    where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Cmm.MachOp
    import GHC.Cmm.Type
    import GHC.Cmm.Reg
    import GHC.Utils.Panic (panic)
    import GHC.Utils.Outputable

    import Data.Maybe
    import Data.Set (Set)
    import qualified Data.Set as Set
    import Numeric ( fromRat )

    import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf)

    -----------------------------------------------------------------------------
    --              CmmExpr
    -- An expression.  Expressions have no side effects.
    -----------------------------------------------------------------------------

    data CmmExpr
      = CmmLit !CmmLit              -- Literal
      | CmmLoad !CmmExpr !CmmType !AlignmentSpec
                                    -- Read memory location
      | CmmReg !CmmReg              -- Contents of register
      | CmmMachOp MachOp [CmmExpr]  -- Machine operation (+, -, *, etc.)
      | CmmStackSlot Area {-# UNPACK #-} !Int
                                    -- Addressing expression of a stack slot
                                    -- See Note [CmmStackSlot aliasing]
      | CmmRegOff !CmmReg !Int
            -- CmmRegOff reg i
            --        ** is shorthand only, meaning **
            -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
            --      where rep = typeWidth (cmmRegType reg)
      deriving Int -> CmmExpr -> ShowS
    [CmmExpr] -> ShowS
    CmmExpr -> String
    (Int -> CmmExpr -> ShowS)
    -> (CmmExpr -> String) -> ([CmmExpr] -> ShowS) -> Show CmmExpr
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CmmExpr -> ShowS
    showsPrec :: Int -> CmmExpr -> ShowS
    $cshow :: CmmExpr -> String
    show :: CmmExpr -> String
    $cshowList :: [CmmExpr] -> ShowS
    showList :: [CmmExpr] -> ShowS
    Show

    instance Eq CmmExpr where       -- Equality ignores the types
      CmmLit CmmLit
    l1          == :: CmmExpr -> CmmExpr -> Bool
    == CmmLit CmmLit
    l2          = CmmLit
    l1CmmLit -> CmmLit -> Bool
    forall a. Eq a => a -> a -> Bool
    ==CmmLit
    l2
      CmmLoad CmmExpr
    e1 CmmType
    _ AlignmentSpec
    _     == CmmLoad CmmExpr
    e2 CmmType
    _ AlignmentSpec
    _     = CmmExpr
    e1CmmExpr -> CmmExpr -> Bool
    forall a. Eq a => a -> a -> Bool
    ==CmmExpr
    e2
      CmmReg CmmReg
    r1          == CmmReg CmmReg
    r2          = CmmReg
    r1CmmReg -> CmmReg -> Bool
    forall a. Eq a => a -> a -> Bool
    ==CmmReg
    r2
      CmmRegOff CmmReg
    r1 Int
    i1    == CmmRegOff CmmReg
    r2 Int
    i2    = CmmReg
    r1CmmReg -> CmmReg -> Bool
    forall a. Eq a => a -> a -> Bool
    ==CmmReg
    r2 Bool -> Bool -> Bool
    && Int
    i1Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    i2
      CmmMachOp MachOp
    op1 [CmmExpr]
    es1  == CmmMachOp MachOp
    op2 [CmmExpr]
    es2  = MachOp
    op1MachOp -> MachOp -> Bool
    forall a. Eq a => a -> a -> Bool
    ==MachOp
    op2 Bool -> Bool -> Bool
    && [CmmExpr]
    es1[CmmExpr] -> [CmmExpr] -> Bool
    forall a. Eq a => a -> a -> Bool
    ==[CmmExpr]
    es2
      CmmStackSlot Area
    a1 Int
    i1 == CmmStackSlot Area
    a2 Int
    i2 = Area
    a1Area -> Area -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Area
    a2 Bool -> Bool -> Bool
    && Int
    i1Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    i2
      CmmExpr
    _e1                == CmmExpr
    _e2                = Bool
    False

    instance OutputableP Platform CmmExpr where
        pdoc :: Platform -> CmmExpr -> SDoc
    pdoc = Platform -> CmmExpr -> SDoc
    pprExpr

    data AlignmentSpec = NaturallyAligned | Unaligned
      deriving (AlignmentSpec -> AlignmentSpec -> Bool
    (AlignmentSpec -> AlignmentSpec -> Bool)
    -> (AlignmentSpec -> AlignmentSpec -> Bool) -> Eq AlignmentSpec
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AlignmentSpec -> AlignmentSpec -> Bool
    == :: AlignmentSpec -> AlignmentSpec -> Bool
    $c/= :: AlignmentSpec -> AlignmentSpec -> Bool
    /= :: AlignmentSpec -> AlignmentSpec -> Bool
    Eq, Eq AlignmentSpec
    Eq AlignmentSpec =>
    (AlignmentSpec -> AlignmentSpec -> Ordering)
    -> (AlignmentSpec -> AlignmentSpec -> Bool)
    -> (AlignmentSpec -> AlignmentSpec -> Bool)
    -> (AlignmentSpec -> AlignmentSpec -> Bool)
    -> (AlignmentSpec -> AlignmentSpec -> Bool)
    -> (AlignmentSpec -> AlignmentSpec -> AlignmentSpec)
    -> (AlignmentSpec -> AlignmentSpec -> AlignmentSpec)
    -> Ord AlignmentSpec
    AlignmentSpec -> AlignmentSpec -> Bool
    AlignmentSpec -> AlignmentSpec -> Ordering
    AlignmentSpec -> AlignmentSpec -> AlignmentSpec
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: AlignmentSpec -> AlignmentSpec -> Ordering
    compare :: AlignmentSpec -> AlignmentSpec -> Ordering
    $c< :: AlignmentSpec -> AlignmentSpec -> Bool
    < :: AlignmentSpec -> AlignmentSpec -> Bool
    $c<= :: AlignmentSpec -> AlignmentSpec -> Bool
    <= :: AlignmentSpec -> AlignmentSpec -> Bool
    $c> :: AlignmentSpec -> AlignmentSpec -> Bool
    > :: AlignmentSpec -> AlignmentSpec -> Bool
    $c>= :: AlignmentSpec -> AlignmentSpec -> Bool
    >= :: AlignmentSpec -> AlignmentSpec -> Bool
    $cmax :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
    max :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
    $cmin :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
    min :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
    Ord, Int -> AlignmentSpec -> ShowS
    [AlignmentSpec] -> ShowS
    AlignmentSpec -> String
    (Int -> AlignmentSpec -> ShowS)
    -> (AlignmentSpec -> String)
    -> ([AlignmentSpec] -> ShowS)
    -> Show AlignmentSpec
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AlignmentSpec -> ShowS
    showsPrec :: Int -> AlignmentSpec -> ShowS
    $cshow :: AlignmentSpec -> String
    show :: AlignmentSpec -> String
    $cshowList :: [AlignmentSpec] -> ShowS
    showList :: [AlignmentSpec] -> ShowS
    Show)

    -- | A stack area is either the stack slot where a variable is spilled
    -- or the stack space where function arguments and results are passed.
    data Area
      = Old            -- See Note [Old Area]
      | Young {-# UNPACK #-} !BlockId  -- Invariant: must be a continuation BlockId
                       -- See Note [Continuation BlockIds] in GHC.Cmm.Node.
      deriving (Area -> Area -> Bool
    (Area -> Area -> Bool) -> (Area -> Area -> Bool) -> Eq Area
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Area -> Area -> Bool
    == :: Area -> Area -> Bool
    $c/= :: Area -> Area -> Bool
    /= :: Area -> Area -> Bool
    Eq, Eq Area
    Eq Area =>
    (Area -> Area -> Ordering)
    -> (Area -> Area -> Bool)
    -> (Area -> Area -> Bool)
    -> (Area -> Area -> Bool)
    -> (Area -> Area -> Bool)
    -> (Area -> Area -> Area)
    -> (Area -> Area -> Area)
    -> Ord Area
    Area -> Area -> Bool
    Area -> Area -> Ordering
    Area -> Area -> Area
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Area -> Area -> Ordering
    compare :: Area -> Area -> Ordering
    $c< :: Area -> Area -> Bool
    < :: Area -> Area -> Bool
    $c<= :: Area -> Area -> Bool
    <= :: Area -> Area -> Bool
    $c> :: Area -> Area -> Bool
    > :: Area -> Area -> Bool
    $c>= :: Area -> Area -> Bool
    >= :: Area -> Area -> Bool
    $cmax :: Area -> Area -> Area
    max :: Area -> Area -> Area
    $cmin :: Area -> Area -> Area
    min :: Area -> Area -> Area
    Ord, Int -> Area -> ShowS
    [Area] -> ShowS
    Area -> String
    (Int -> Area -> ShowS)
    -> (Area -> String) -> ([Area] -> ShowS) -> Show Area
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Area -> ShowS
    showsPrec :: Int -> Area -> ShowS
    $cshow :: Area -> String
    show :: Area -> String
    $cshowList :: [Area] -> ShowS
    showList :: [Area] -> ShowS
    Show)

    instance Outputable Area where
        ppr :: Area -> SDoc
    ppr Area
    e = Area -> SDoc
    pprArea Area
    e

    pprArea :: Area -> SDoc
    pprArea :: Area -> SDoc
    pprArea Area
    Old        = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "old"
    pprArea (Young BlockId
    id) = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "young<", BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    id, String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ">" ]

    {- Note [Old Area]
    ~~~~~~~~~~~~~~~~~~
    There is a single call area 'Old', allocated at the extreme old
    end of the stack frame (ie just younger than the return address)
    which holds:
      * incoming (overflow) parameters,
      * outgoing (overflow) parameter to tail calls,
      * outgoing (overflow) result values
      * the update frame (if any)

    Its size is the max of all these requirements.  On entry, the stack
    pointer will point to the youngest incoming parameter, which is not
    necessarily at the young end of the Old area.

    End of note -}

    {- Note [CmmStackSlot aliasing]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When do two CmmStackSlots alias?

     - T[old+N] aliases with U[young(L)+M] for all T, U, L, N and M
     - T[old+N] aliases with U[old+M] only if the areas actually overlap

    Or more informally, different Areas may overlap with each other.

    An alternative semantics, that we previously had, was that different
    Areas do not overlap.  The problem that lead to redefining the
    semantics of stack areas is described below.

    e.g. if we had

        x = Sp[old + 8]
        y = Sp[old + 16]

        Sp[young(L) + 8]  = L
        Sp[young(L) + 16] = y
        Sp[young(L) + 24] = x
        call f() returns to L

    if areas semantically do not overlap, then we might optimise this to

        Sp[young(L) + 8]  = L
        Sp[young(L) + 16] = Sp[old + 8]
        Sp[young(L) + 24] = Sp[old + 16]
        call f() returns to L

    and now young(L) cannot be allocated at the same place as old, and we
    are doomed to use more stack.

      - old+8  conflicts with young(L)+8
      - old+16 conflicts with young(L)+16 and young(L)+8

    so young(L)+8 == old+24 and we get

        Sp[-8]  = L
        Sp[-16] = Sp[8]
        Sp[-24] = Sp[0]
        Sp -= 24
        call f() returns to L

    However, if areas are defined to be "possibly overlapping" in the
    semantics, then we cannot commute any loads/stores of old with
    young(L), and we will be able to re-use both old+8 and old+16 for
    young(L).

        x = Sp[8]
        y = Sp[0]

        Sp[8] = L
        Sp[0] = y
        Sp[-8] = x
        Sp = Sp - 8
        call f() returns to L

    Now, the assignments of y go away,

        x = Sp[8]
        Sp[8] = L
        Sp[-8] = x
        Sp = Sp - 8
        call f() returns to L
    -}

    data CmmLit
      = CmmInt !Integer  !Width
            -- Interpretation: the 2's complement representation of the value
            -- is truncated to the specified size.  This is easier than trying
            -- to keep the value within range, because we don't know whether
            -- it will be used as a signed or unsigned value (the CmmType doesn't
            -- distinguish between signed & unsigned).
      | CmmFloat  Rational !Width
      | CmmVec [CmmLit]                     -- Vector literal
      | CmmLabel    CLabel                  -- Address of label
      | CmmLabelOff CLabel !Int              -- Address of label + byte offset

            -- Due to limitations in the C backend, the following
            -- MUST ONLY be used inside the info table indicated by label2
            -- (label2 must be the info label), and label1 must be an
            -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
            -- Don't use it at all unless tablesNextToCode.
            -- It is also used inside the NCG during when generating
            -- position-independent code.
      | CmmLabelDiffOff CLabel CLabel !Int !Width -- label1 - label2 + offset
            -- In an expression, the width just has the effect of MO_SS_Conv
            -- from wordWidth to the desired width.
            --
            -- In a static literal, the supported Widths depend on the
            -- architecture: wordWidth is supported on all
            -- architectures. Additionally W32 is supported on x86_64 when
            -- using the small memory model.

      | CmmBlock {-# UNPACK #-} !BlockId     -- Code label
            -- Invariant: must be a continuation BlockId
            -- See Note [Continuation BlockIds] in GHC.Cmm.Node.

      | CmmHighStackMark -- A late-bound constant that stands for the max
                         -- #bytes of stack space used during a procedure.
                         -- During the stack-layout pass, CmmHighStackMark
                         -- is replaced by a CmmInt for the actual number
                         -- of bytes used
      deriving (CmmLit -> CmmLit -> Bool
    (CmmLit -> CmmLit -> Bool)
    -> (CmmLit -> CmmLit -> Bool) -> Eq CmmLit
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CmmLit -> CmmLit -> Bool
    == :: CmmLit -> CmmLit -> Bool
    $c/= :: CmmLit -> CmmLit -> Bool
    /= :: CmmLit -> CmmLit -> Bool
    Eq, Int -> CmmLit -> ShowS
    [CmmLit] -> ShowS
    CmmLit -> String
    (Int -> CmmLit -> ShowS)
    -> (CmmLit -> String) -> ([CmmLit] -> ShowS) -> Show CmmLit
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CmmLit -> ShowS
    showsPrec :: Int -> CmmLit -> ShowS
    $cshow :: CmmLit -> String
    show :: CmmLit -> String
    $cshowList :: [CmmLit] -> ShowS
    showList :: [CmmLit] -> ShowS
    Show)

    instance OutputableP Platform CmmLit where
        pdoc :: Platform -> CmmLit -> SDoc
    pdoc = Platform -> CmmLit -> SDoc
    pprLit

    instance Outputable CmmLit where
      ppr :: CmmLit -> SDoc
    ppr (CmmInt Integer
    n Width
    w) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmInt" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Integer -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Integer
    n SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w
      ppr (CmmFloat Rational
    n Width
    w) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmFloat" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (Rational -> String
    forall a. Show a => a -> String
    show Rational
    n) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w
      ppr (CmmVec [CmmLit]
    xs) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmVec" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [CmmLit] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CmmLit]
    xs
      ppr (CmmLabel CLabel
    _) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmLabel"
      ppr (CmmLabelOff CLabel
    _ Int
    _) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmLabelOff"
      ppr (CmmLabelDiffOff CLabel
    _ CLabel
    _ Int
    _ Width
    _) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmLabelDiffOff"
      ppr (CmmBlock BlockId
    blk) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmBlock" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    blk
      ppr CmmLit
    CmmHighStackMark = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmHighStackMark"

    cmmExprType :: Platform -> CmmExpr -> CmmType
    cmmExprType :: Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform = \case
       (CmmLit CmmLit
    lit)        -> Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit
       (CmmLoad CmmExpr
    _ CmmType
    rep AlignmentSpec
    _)   -> CmmType
    rep
       (CmmReg CmmReg
    reg)        -> Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg
       (CmmMachOp MachOp
    op [CmmExpr]
    args) -> Platform -> MachOp -> [CmmType] -> CmmType
    machOpResultType Platform
    platform MachOp
    op ((CmmExpr -> CmmType) -> [CmmExpr] -> [CmmType]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform) [CmmExpr]
    args)
       (CmmRegOff CmmReg
    reg Int
    _)   -> Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg
       (CmmStackSlot Area
    _ Int
    _)  -> Platform -> CmmType
    bWord Platform
    platform -- an address
       -- Careful though: what is stored at the stack slot may be bigger than
       -- an address

    cmmLitType :: Platform -> CmmLit -> CmmType
    cmmLitType :: Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform = \case
       (CmmInt Integer
    _ Width
    width)     -> Width -> CmmType
    cmmBits  Width
    width
       (CmmFloat Rational
    _ Width
    width)   -> Width -> CmmType
    cmmFloat Width
    width
       (CmmVec [])          -> String -> CmmType
    forall a. HasCallStack => String -> a
    panic String
    "cmmLitType: CmmVec []"
       (CmmVec (CmmLit
    l:[CmmLit]
    ls))      -> let ty :: CmmType
    ty = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    l
                              in if (CmmType -> Bool) -> [CmmType] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (CmmType -> CmmType -> Bool
    `cmmEqType` CmmType
    ty) ((CmmLit -> CmmType) -> [CmmLit] -> [CmmType]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform) [CmmLit]
    ls)
                                   then Int -> CmmType -> CmmType
    cmmVec (Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +[CmmLit] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CmmLit]
    ls) CmmType
    ty
                                   else String -> CmmType
    forall a. HasCallStack => String -> a
    panic String
    "cmmLitType: CmmVec"
       (CmmLabel CLabel
    lbl)       -> Platform -> CLabel -> CmmType
    cmmLabelType Platform
    platform CLabel
    lbl
       (CmmLabelOff CLabel
    lbl Int
    _)  -> Platform -> CLabel -> CmmType
    cmmLabelType Platform
    platform CLabel
    lbl
       (CmmLabelDiffOff CLabel
    _ CLabel
    _ Int
    _ Width
    width) -> Width -> CmmType
    cmmBits Width
    width
       (CmmBlock BlockId
    _)         -> Platform -> CmmType
    bWord Platform
    platform
       (CmmLit
    CmmHighStackMark)   -> Platform -> CmmType
    bWord Platform
    platform

    cmmLabelType :: Platform -> CLabel -> CmmType
    cmmLabelType :: Platform -> CLabel -> CmmType
    cmmLabelType Platform
    platform CLabel
    lbl
     | CLabel -> Bool
    isGcPtrLabel CLabel
    lbl = Platform -> CmmType
    gcWord Platform
    platform
     | Bool
    otherwise        = Platform -> CmmType
    bWord Platform
    platform

    cmmExprWidth :: Platform -> CmmExpr -> Width
    cmmExprWidth :: Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    e = CmmType -> Width
    typeWidth (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    e)

    -- | Returns an alignment in bytes of a CmmExpr when it's a statically
    -- known integer constant, otherwise returns an alignment of 1 byte.
    -- The caller is responsible for using with a sensible CmmExpr
    -- argument.
    cmmExprAlignment :: CmmExpr -> Alignment
    cmmExprAlignment :: CmmExpr -> Alignment
    cmmExprAlignment (CmmLit (CmmInt Integer
    intOff Width
    _)) = Int -> Alignment
    alignmentOf (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    intOff)
    cmmExprAlignment CmmExpr
    _                          = Int -> Alignment
    mkAlignment Int
    1
    --------
    --- Negation for conditional branches

    maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
    maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
    maybeInvertCmmExpr (CmmMachOp MachOp
    op [CmmExpr]
    args) = do MachOp
    op' <- MachOp -> Maybe MachOp
    maybeInvertComparison MachOp
    op
                                                CmmExpr -> Maybe CmmExpr
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    op' [CmmExpr]
    args)
    maybeInvertCmmExpr CmmExpr
    _ = Maybe CmmExpr
    forall a. Maybe a
    Nothing

    ---------------------------------------------------
    --         CmmExpr predicates
    ---------------------------------------------------

    isTrivialCmmExpr :: CmmExpr -> Bool
    isTrivialCmmExpr :: CmmExpr -> Bool
    isTrivialCmmExpr (CmmLoad CmmExpr
    _ CmmType
    _ AlignmentSpec
    _)    = Bool
    False
    isTrivialCmmExpr (CmmMachOp MachOp
    _ [CmmExpr]
    _)    = Bool
    False
    isTrivialCmmExpr (CmmLit CmmLit
    _)         = Bool
    True
    isTrivialCmmExpr (CmmReg CmmReg
    _)         = Bool
    True
    isTrivialCmmExpr (CmmRegOff CmmReg
    _ Int
    _)    = Bool
    True
    isTrivialCmmExpr (CmmStackSlot Area
    _ Int
    _) = String -> Bool
    forall a. HasCallStack => String -> a
    panic String
    "isTrivialCmmExpr CmmStackSlot"

    hasNoGlobalRegs :: CmmExpr -> Bool
    hasNoGlobalRegs :: CmmExpr -> Bool
    hasNoGlobalRegs (CmmLoad CmmExpr
    e CmmType
    _ AlignmentSpec
    _)            = CmmExpr -> Bool
    hasNoGlobalRegs CmmExpr
    e
    hasNoGlobalRegs (CmmMachOp MachOp
    _ [CmmExpr]
    es)           = (CmmExpr -> Bool) -> [CmmExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all CmmExpr -> Bool
    hasNoGlobalRegs [CmmExpr]
    es
    hasNoGlobalRegs (CmmLit CmmLit
    _)                 = Bool
    True
    hasNoGlobalRegs (CmmReg (CmmLocal LocalReg
    _))      = Bool
    True
    hasNoGlobalRegs (CmmRegOff (CmmLocal LocalReg
    _) Int
    _) = Bool
    True
    hasNoGlobalRegs CmmExpr
    _                          = Bool
    False

    isLit :: CmmExpr -> Bool
    isLit :: CmmExpr -> Bool
    isLit (CmmLit CmmLit
    _) = Bool
    True
    isLit CmmExpr
    _          = Bool
    False

    isComparisonExpr :: CmmExpr -> Bool
    isComparisonExpr :: CmmExpr -> Bool
    isComparisonExpr (CmmMachOp MachOp
    op [CmmExpr]
    _) = MachOp -> Bool
    isComparisonMachOp MachOp
    op
    isComparisonExpr CmmExpr
    _                = Bool
    False

    -----------------------------------------------------------------------------
    --    Register-use information for expressions and other types
    -----------------------------------------------------------------------------

    -- | Sets of registers

    -- These are used for dataflow facts, and a common operation is taking
    -- the union of two RegSets and then asking whether the union is the
    -- same as one of the inputs.  UniqSet isn't good here, because
    -- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
    -- Sets.

    type RegSet r     = Set r
    type LocalRegSet  = RegSet LocalReg
    type GlobalRegSet = RegSet GlobalReg

    emptyRegSet             :: RegSet r
    nullRegSet              :: RegSet r -> Bool
    elemRegSet              :: Ord r => r -> RegSet r -> Bool
    extendRegSet            :: Ord r => RegSet r -> r -> RegSet r
    deleteFromRegSet        :: Ord r => RegSet r -> r -> RegSet r
    mkRegSet                :: Ord r => [r] -> RegSet r
    minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
    sizeRegSet              :: RegSet r -> Int
    regSetToList            :: RegSet r -> [r]

    emptyRegSet :: forall r. RegSet r
    emptyRegSet      = Set r
    forall r. RegSet r
    Set.empty
    nullRegSet :: forall r. RegSet r -> Bool
    nullRegSet       = Set r -> Bool
    forall r. RegSet r -> Bool
    Set.null
    elemRegSet :: forall r. Ord r => r -> RegSet r -> Bool
    elemRegSet       = r -> Set r -> Bool
    forall r. Ord r => r -> RegSet r -> Bool
    Set.member
    extendRegSet :: forall r. Ord r => RegSet r -> r -> RegSet r
    extendRegSet     = (r -> RegSet r -> RegSet r) -> RegSet r -> r -> RegSet r
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip r -> RegSet r -> RegSet r
    forall a. Ord a => a -> Set a -> Set a
    Set.insert
    deleteFromRegSet :: forall r. Ord r => RegSet r -> r -> RegSet r
    deleteFromRegSet = (r -> RegSet r -> RegSet r) -> RegSet r -> r -> RegSet r
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip r -> RegSet r -> RegSet r
    forall a. Ord a => a -> Set a -> Set a
    Set.delete
    mkRegSet :: forall r. Ord r => [r] -> RegSet r
    mkRegSet         = [r] -> Set r
    forall r. Ord r => [r] -> RegSet r
    Set.fromList
    minusRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
    minusRegSet      = Set r -> Set r -> Set r
    forall r. Ord r => RegSet r -> RegSet r -> RegSet r
    Set.difference
    plusRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
    plusRegSet       = Set r -> Set r -> Set r
    forall r. Ord r => RegSet r -> RegSet r -> RegSet r
    Set.union
    timesRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
    timesRegSet      = Set r -> Set r -> Set r
    forall r. Ord r => RegSet r -> RegSet r -> RegSet r
    Set.intersection
    sizeRegSet :: forall r. RegSet r -> Int
    sizeRegSet       = Set r -> Int
    forall r. RegSet r -> Int
    Set.size
    regSetToList :: forall r. RegSet r -> [r]
    regSetToList     = Set r -> [r]
    forall r. RegSet r -> [r]
    Set.toList

    class Ord r => UserOfRegs r a where
      foldRegsUsed :: Platform -> (b -> r -> b) -> b -> a -> b

    foldLocalRegsUsed :: UserOfRegs LocalReg a
                      => Platform -> (b -> LocalReg -> b) -> b -> a -> b
    foldLocalRegsUsed :: forall a b.
    UserOfRegs LocalReg a =>
    Platform -> (b -> LocalReg -> b) -> b -> a -> b
    foldLocalRegsUsed = Platform -> (b -> LocalReg -> b) -> b -> a -> b
    forall b. Platform -> (b -> LocalReg -> b) -> b -> a -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed

    class Ord r => DefinerOfRegs r a where
      foldRegsDefd :: Platform -> (b -> r -> b) -> b -> a -> b

    foldLocalRegsDefd :: DefinerOfRegs LocalReg a
                      => Platform -> (b -> LocalReg -> b) -> b -> a -> b
    foldLocalRegsDefd :: forall a b.
    DefinerOfRegs LocalReg a =>
    Platform -> (b -> LocalReg -> b) -> b -> a -> b
    foldLocalRegsDefd = Platform -> (b -> LocalReg -> b) -> b -> a -> b
    forall b. Platform -> (b -> LocalReg -> b) -> b -> a -> b
    forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd

    instance UserOfRegs LocalReg CmmReg where
        foldRegsUsed :: forall b. Platform -> (b -> LocalReg -> b) -> b -> CmmReg -> b
    foldRegsUsed Platform
    _ b -> LocalReg -> b
    f b
    z (CmmLocal LocalReg
    reg) = b -> LocalReg -> b
    f b
    z LocalReg
    reg
        foldRegsUsed Platform
    _ b -> LocalReg -> b
    _ b
    z (CmmGlobal GlobalReg
    _)  = b
    z

    instance DefinerOfRegs LocalReg CmmReg where
        foldRegsDefd :: forall b. Platform -> (b -> LocalReg -> b) -> b -> CmmReg -> b
    foldRegsDefd Platform
    _ b -> LocalReg -> b
    f b
    z (CmmLocal LocalReg
    reg) = b -> LocalReg -> b
    f b
    z LocalReg
    reg
        foldRegsDefd Platform
    _ b -> LocalReg -> b
    _ b
    z (CmmGlobal GlobalReg
    _)  = b
    z

    instance UserOfRegs GlobalReg CmmReg where
        {-# INLINEABLE foldRegsUsed #-}
        foldRegsUsed :: forall b. Platform -> (b -> GlobalReg -> b) -> b -> CmmReg -> b
    foldRegsUsed Platform
    _ b -> GlobalReg -> b
    _ b
    z (CmmLocal LocalReg
    _)    = b
    z
        foldRegsUsed Platform
    _ b -> GlobalReg -> b
    f b
    z (CmmGlobal GlobalReg
    reg) = b -> GlobalReg -> b
    f b
    z GlobalReg
    reg

    instance DefinerOfRegs GlobalReg CmmReg where
        foldRegsDefd :: forall b. Platform -> (b -> GlobalReg -> b) -> b -> CmmReg -> b
    foldRegsDefd Platform
    _ b -> GlobalReg -> b
    _ b
    z (CmmLocal LocalReg
    _)    = b
    z
        foldRegsDefd Platform
    _ b -> GlobalReg -> b
    f b
    z (CmmGlobal GlobalReg
    reg) = b -> GlobalReg -> b
    f b
    z GlobalReg
    reg

    instance Ord r => UserOfRegs r r where
        foldRegsUsed :: forall b. Platform -> (b -> r -> b) -> b -> r -> b
    foldRegsUsed Platform
    _ b -> r -> b
    f b
    z r
    r = b -> r -> b
    f b
    z r
    r

    instance Ord r => DefinerOfRegs r r where
        foldRegsDefd :: forall b. Platform -> (b -> r -> b) -> b -> r -> b
    foldRegsDefd Platform
    _ b -> r -> b
    f b
    z r
    r = b -> r -> b
    f b
    z r
    r

    instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
      -- The (Ord r) in the context is necessary here
      -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance
      {-# INLINEABLE foldRegsUsed #-}
      foldRegsUsed :: forall b. Platform -> (b -> r -> b) -> b -> CmmExpr -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f !b
    z CmmExpr
    e = b -> CmmExpr -> b
    expr b
    z CmmExpr
    e
        where expr :: b -> CmmExpr -> b
    expr b
    z (CmmLit CmmLit
    _)          = b
    z
              expr b
    z (CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _)  = Platform -> (b -> r -> b) -> b -> CmmExpr -> b
    forall b. Platform -> (b -> r -> b) -> b -> CmmExpr -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f b
    z CmmExpr
    addr
              expr b
    z (CmmReg CmmReg
    r)          = Platform -> (b -> r -> b) -> b -> CmmReg -> b
    forall b. Platform -> (b -> r -> b) -> b -> CmmReg -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f b
    z CmmReg
    r
              expr b
    z (CmmMachOp MachOp
    _ [CmmExpr]
    exprs) = Platform -> (b -> r -> b) -> b -> [CmmExpr] -> b
    forall b. Platform -> (b -> r -> b) -> b -> [CmmExpr] -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f b
    z [CmmExpr]
    exprs
              expr b
    z (CmmRegOff CmmReg
    r Int
    _)     = Platform -> (b -> r -> b) -> b -> CmmReg -> b
    forall b. Platform -> (b -> r -> b) -> b -> CmmReg -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f b
    z CmmReg
    r
              expr b
    z (CmmStackSlot Area
    _ Int
    _)  = b
    z

    instance UserOfRegs r a => UserOfRegs r [a] where
      foldRegsUsed :: forall b. Platform -> (b -> r -> b) -> b -> [a] -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f b
    set [a]
    as = (b -> a -> b) -> b -> [a] -> b
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Platform -> (b -> r -> b) -> b -> a -> b
    forall b. Platform -> (b -> r -> b) -> b -> a -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f) b
    set [a]
    as
      {-# INLINABLE foldRegsUsed #-}

    instance DefinerOfRegs r a => DefinerOfRegs r [a] where
      foldRegsDefd :: forall b. Platform -> (b -> r -> b) -> b -> [a] -> b
    foldRegsDefd Platform
    platform b -> r -> b
    f b
    set [a]
    as = (b -> a -> b) -> b -> [a] -> b
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Platform -> (b -> r -> b) -> b -> a -> b
    forall b. Platform -> (b -> r -> b) -> b -> a -> b
    forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd Platform
    platform b -> r -> b
    f) b
    set [a]
    as
      {-# INLINABLE foldRegsDefd #-}

    -- --------------------------------------------------------------------------
    -- Pretty-printing expressions
    -- --------------------------------------------------------------------------

    pprExpr :: Platform -> CmmExpr -> SDoc
    pprExpr :: Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    e
        = case CmmExpr
    e of
            CmmRegOff CmmReg
    reg Int
    i ->
                    Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    rep)
                               [CmmReg -> CmmExpr
    CmmReg CmmReg
    reg, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i) Width
    rep)])
                    where rep :: Width
    rep = CmmType -> Width
    typeWidth (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg)
            CmmLit CmmLit
    lit -> Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit
            CmmExpr
    _other     -> Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform CmmExpr
    e

    -- Here's the precedence table from GHC.Cmm.Parser:
    -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
    -- %left '|'
    -- %left '^'
    -- %left '&'
    -- %left '>>' '<<'
    -- %left '-' '+'
    -- %left '/' '*' '%'
    -- %right '~'

    -- We just cope with the common operators for now, the rest will get
    -- a default conservative behaviour.

    -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
    pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
    pprExpr1 :: Platform -> CmmExpr -> SDoc
    pprExpr1 Platform
    platform (CmmMachOp MachOp
    op [CmmExpr
    x,CmmExpr
    y])
       | Just SDoc
    doc <- MachOp -> Maybe SDoc
    infixMachOp1 MachOp
    op
       = Platform -> CmmExpr -> SDoc
    pprExpr7 Platform
    platform CmmExpr
    x SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    pprExpr7 Platform
    platform CmmExpr
    y
    pprExpr1 Platform
    platform CmmExpr
    e = Platform -> CmmExpr -> SDoc
    pprExpr7 Platform
    platform CmmExpr
    e

    infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc

    infixMachOp1 :: MachOp -> Maybe SDoc
    infixMachOp1 (MO_Eq     Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "==")
    infixMachOp1 (MO_Ne     Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "!=")
    infixMachOp1 (MO_Shl    Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<<")
    infixMachOp1 (MO_U_Shr  Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ">>")
    infixMachOp1 (MO_U_Ge   Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ">=")
    infixMachOp1 (MO_U_Le   Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<=")
    infixMachOp1 (MO_U_Gt   Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '>')
    infixMachOp1 (MO_U_Lt   Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '<')
    infixMachOp1 MachOp
    _             = Maybe SDoc
    forall a. Maybe a
    Nothing

    -- %left '-' '+'
    pprExpr7 :: Platform -> CmmExpr -> SDoc
    pprExpr7 Platform
    platform (CmmMachOp (MO_Add Width
    rep1) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    rep2)]) | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0
       = Platform -> CmmExpr -> SDoc
    pprExpr7 Platform
    platform (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Sub Width
    rep1) [CmmExpr
    x, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Integer -> Integer
    forall a. Num a => a -> a
    negate Integer
    i) Width
    rep2)])
    pprExpr7 Platform
    platform (CmmMachOp MachOp
    op [CmmExpr
    x,CmmExpr
    y])
       | Just SDoc
    doc <- MachOp -> Maybe SDoc
    infixMachOp7 MachOp
    op
       = Platform -> CmmExpr -> SDoc
    pprExpr7 Platform
    platform CmmExpr
    x SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    pprExpr8 Platform
    platform CmmExpr
    y
    pprExpr7 Platform
    platform CmmExpr
    e = Platform -> CmmExpr -> SDoc
    pprExpr8 Platform
    platform CmmExpr
    e

    infixMachOp7 :: MachOp -> Maybe SDoc
    infixMachOp7 (MO_Add Width
    _)  = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '+')
    infixMachOp7 (MO_Sub Width
    _)  = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '-')
    infixMachOp7 MachOp
    _           = Maybe SDoc
    forall a. Maybe a
    Nothing

    -- %left '/' '*' '%'
    pprExpr8 :: Platform -> CmmExpr -> SDoc
    pprExpr8 Platform
    platform (CmmMachOp MachOp
    op [CmmExpr
    x,CmmExpr
    y])
       | Just SDoc
    doc <- MachOp -> Maybe SDoc
    infixMachOp8 MachOp
    op
       = Platform -> CmmExpr -> SDoc
    pprExpr8 Platform
    platform CmmExpr
    x SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    pprExpr9 Platform
    platform CmmExpr
    y
    pprExpr8 Platform
    platform CmmExpr
    e = Platform -> CmmExpr -> SDoc
    pprExpr9 Platform
    platform CmmExpr
    e

    infixMachOp8 :: MachOp -> Maybe SDoc
    infixMachOp8 (MO_U_Quot Width
    _) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '/')
    infixMachOp8 (MO_Mul Width
    _)    = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '*')
    infixMachOp8 (MO_U_Rem Width
    _)  = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '%')
    infixMachOp8 MachOp
    _             = Maybe SDoc
    forall a. Maybe a
    Nothing

    pprExpr9 :: Platform -> CmmExpr -> SDoc
    pprExpr9 :: Platform -> CmmExpr -> SDoc
    pprExpr9 Platform
    platform CmmExpr
    e =
       case CmmExpr
    e of
            CmmLit    CmmLit
    lit       -> Platform -> CmmLit -> SDoc
    pprLit1 Platform
    platform CmmLit
    lit
            CmmLoad   CmmExpr
    expr CmmType
    rep AlignmentSpec
    align
                                -> let align_mark :: SDoc
    align_mark =
                                           case AlignmentSpec
    align of
                                             AlignmentSpec
    NaturallyAligned -> SDoc
    forall doc. IsOutput doc => doc
    empty
                                             AlignmentSpec
    Unaligned        -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "^"
                                    in CmmType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmType
    rep SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    align_mark SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    brackets (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr)
            CmmReg    CmmReg
    reg       -> CmmReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmReg
    reg
            CmmRegOff  CmmReg
    reg Int
    off  -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (CmmReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmReg
    reg SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '+' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    off)
            CmmStackSlot Area
    a Int
    off  -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Area -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Area
    a   SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '+' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    off)
            CmmMachOp MachOp
    mop [CmmExpr]
    args  -> Platform -> MachOp -> [CmmExpr] -> SDoc
    genMachOp Platform
    platform MachOp
    mop [CmmExpr]
    args

    genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
    genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
    genMachOp Platform
    platform MachOp
    mop [CmmExpr]
    args
       | Just SDoc
    doc <- MachOp -> Maybe SDoc
    infixMachOp MachOp
    mop = case [CmmExpr]
    args of
            -- dyadic
            [CmmExpr
    x,CmmExpr
    y] -> Platform -> CmmExpr -> SDoc
    pprExpr9 Platform
    platform CmmExpr
    x SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    pprExpr9 Platform
    platform CmmExpr
    y

            -- unary
            [CmmExpr
    x]   -> SDoc
    doc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Platform -> CmmExpr -> SDoc
    pprExpr9 Platform
    platform CmmExpr
    x

            [CmmExpr]
    _     -> String -> SDoc -> SDoc -> SDoc
    forall a. String -> SDoc -> a -> a
    pprTrace String
    "GHC.Cmm.Expr.genMachOp: machop with strange number of args"
                              (MachOp -> SDoc
    pprMachOp MachOp
    mop SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                                SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ((CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform) [CmmExpr]
    args)))
                              SDoc
    forall doc. IsOutput doc => doc
    empty

       | Maybe SDoc -> Bool
    forall a. Maybe a -> Bool
    isJust (MachOp -> Maybe SDoc
    infixMachOp1 MachOp
    mop)
       Bool -> Bool -> Bool
    || Maybe SDoc -> Bool
    forall a. Maybe a -> Bool
    isJust (MachOp -> Maybe SDoc
    infixMachOp7 MachOp
    mop)
       Bool -> Bool -> Bool
    || Maybe SDoc -> Bool
    forall a. Maybe a -> Bool
    isJust (MachOp -> Maybe SDoc
    infixMachOp8 MachOp
    mop)  = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    mop [CmmExpr]
    args))

       | Bool
    otherwise = Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '%' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    ppr_op SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([SDoc] -> SDoc
    commafy ((CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform) [CmmExpr]
    args))
            where ppr_op :: SDoc
    ppr_op = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map (\Char
    c -> if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' then Char
    '_' else Char
    c)
                                     (MachOp -> String
    forall a. Show a => a -> String
    show MachOp
    mop))
                    -- replace spaces in (show mop) with underscores,

    --
    -- Unsigned ops on the word size of the machine get nice symbols.
    -- All else get dumped in their ugly format.
    --
    infixMachOp :: MachOp -> Maybe SDoc
    infixMachOp :: MachOp -> Maybe SDoc
    infixMachOp MachOp
    mop
            = case MachOp
    mop of
                MO_And    Width
    _ -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '&'
                MO_Or     Width
    _ -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '|'
                MO_Xor    Width
    _ -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '^'
                MO_Not    Width
    _ -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '~'
                MO_S_Neg  Width
    _ -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '-' -- there is no unsigned neg :)
                MachOp
    _ -> Maybe SDoc
    forall a. Maybe a
    Nothing

    -- --------------------------------------------------------------------------
    -- Pretty-printing literals
    --
    --  To minimise line noise we adopt the convention that if the literal
    --  has the natural machine word size, we do not append the type
    -- --------------------------------------------------------------------------

    pprLit :: Platform -> CmmLit -> SDoc
    pprLit :: Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit = case CmmLit
    lit of
        CmmInt Integer
    i Width
    rep ->
            [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [ (if Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 then SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens else SDoc -> SDoc
    forall a. a -> a
    id)(Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    i)
                 , Bool -> SDoc -> SDoc
    forall doc. IsOutput doc => Bool -> doc -> doc
    ppUnless (Width
    rep Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                   SDoc
    forall doc. IsLine doc => doc
    space SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    rep ]

        CmmFloat Rational
    f Width
    rep     -> [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep [ Double -> SDoc
    forall doc. IsLine doc => Double -> doc
    double (Rational -> Double
    forall a. RealFloat a => Rational -> a
    fromRat Rational
    f), SDoc
    dcolon, Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    rep ]
        CmmVec [CmmLit]
    lits        -> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '<' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [SDoc] -> SDoc
    commafy ((CmmLit -> SDoc) -> [CmmLit] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmLit -> SDoc
    pprLit Platform
    platform) [CmmLit]
    lits) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '>'
        CmmLabel CLabel
    clbl      -> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    clbl
        CmmLabelOff CLabel
    clbl Int
    i -> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    clbl SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> SDoc
    ppr_offset Int
    i
        CmmLabelDiffOff CLabel
    clbl1 CLabel
    clbl2 Int
    i Width
    _ -> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    clbl1 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '-'
                                           SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    clbl2 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> SDoc
    ppr_offset Int
    i
        CmmBlock BlockId
    id        -> BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    id
        CmmLit
    CmmHighStackMark -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<highSp>"

    pprLit1 :: Platform -> CmmLit -> SDoc
    pprLit1 :: Platform -> CmmLit -> SDoc
    pprLit1 Platform
    platform lit :: CmmLit
    lit@(CmmLabelOff {}) = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit)
    pprLit1 Platform
    platform CmmLit
    lit                  = Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit

    ppr_offset :: Int -> SDoc
    ppr_offset :: Int -> SDoc
    ppr_offset Int
    i
        | Int
    iInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0      = SDoc
    forall doc. IsOutput doc => doc
    empty
        | Int
    iInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >=Int
    0      = Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '+' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    i
        | Bool
    otherwise = Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '-' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int (-Int
    i)

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