{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmmExpr] -> ShowS
$cshowList :: [CmmExpr] -> ShowS
show :: CmmExpr -> String
$cshow :: CmmExpr -> String
showsPrec :: Int -> CmmExpr -> ShowS
$cshowsPrec :: Int -> CmmExpr -> ShowS
Show

instance Eq CmmExpr where       -- Equality ignores the types
  CmmLit CmmLit
l1          == :: CmmExpr -> CmmExpr -> Bool
== CmmLit CmmLit
l2          = CmmLit
l1forall a. Eq a => a -> a -> Bool
==CmmLit
l2
  CmmLoad CmmExpr
e1 CmmType
_ AlignmentSpec
_     == CmmLoad CmmExpr
e2 CmmType
_ AlignmentSpec
_     = CmmExpr
e1forall a. Eq a => a -> a -> Bool
==CmmExpr
e2
  CmmReg CmmReg
r1          == CmmReg CmmReg
r2          = CmmReg
r1forall a. Eq a => a -> a -> Bool
==CmmReg
r2
  CmmRegOff CmmReg
r1 Int
i1    == CmmRegOff CmmReg
r2 Int
i2    = CmmReg
r1forall a. Eq a => a -> a -> Bool
==CmmReg
r2 Bool -> Bool -> Bool
&& Int
i1forall a. Eq a => a -> a -> Bool
==Int
i2
  CmmMachOp MachOp
op1 [CmmExpr]
es1  == CmmMachOp MachOp
op2 [CmmExpr]
es2  = MachOp
op1forall a. Eq a => a -> a -> Bool
==MachOp
op2 Bool -> Bool -> Bool
&& [CmmExpr]
es1forall a. Eq a => a -> a -> Bool
==[CmmExpr]
es2
  CmmStackSlot Area
a1 Int
i1 == CmmStackSlot Area
a2 Int
i2 = Area
a1forall a. Eq a => a -> a -> Bool
==Area
a2 Bool -> Bool -> Bool
&& Int
i1forall 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignmentSpec -> AlignmentSpec -> Bool
$c/= :: AlignmentSpec -> AlignmentSpec -> Bool
== :: AlignmentSpec -> AlignmentSpec -> Bool
$c== :: AlignmentSpec -> AlignmentSpec -> Bool
Eq, Eq 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
min :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
$cmin :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
max :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
$cmax :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
>= :: AlignmentSpec -> AlignmentSpec -> Bool
$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
compare :: AlignmentSpec -> AlignmentSpec -> Ordering
$ccompare :: AlignmentSpec -> AlignmentSpec -> Ordering
Ord, Int -> AlignmentSpec -> ShowS
[AlignmentSpec] -> ShowS
AlignmentSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlignmentSpec] -> ShowS
$cshowList :: [AlignmentSpec] -> ShowS
show :: AlignmentSpec -> String
$cshow :: AlignmentSpec -> String
showsPrec :: Int -> AlignmentSpec -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Area -> Area -> Bool
$c/= :: Area -> Area -> Bool
== :: Area -> Area -> Bool
$c== :: Area -> Area -> Bool
Eq, Eq 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
min :: Area -> Area -> Area
$cmin :: Area -> Area -> Area
max :: Area -> Area -> Area
$cmax :: Area -> Area -> Area
>= :: Area -> Area -> Bool
$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
compare :: Area -> Area -> Ordering
$ccompare :: Area -> Area -> Ordering
Ord, Int -> Area -> ShowS
[Area] -> ShowS
Area -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Area] -> ShowS
$cshowList :: [Area] -> ShowS
show :: Area -> String
$cshow :: Area -> String
showsPrec :: Int -> Area -> ShowS
$cshowsPrec :: Int -> 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        = forall doc. IsLine doc => String -> doc
text String
"old"
pprArea (Young BlockId
id) = forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsLine doc => String -> doc
text String
"young<", forall a. Outputable a => a -> SDoc
ppr BlockId
id, 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmmLit -> CmmLit -> Bool
$c/= :: CmmLit -> CmmLit -> Bool
== :: CmmLit -> CmmLit -> Bool
$c== :: CmmLit -> CmmLit -> Bool
Eq, Int -> CmmLit -> ShowS
[CmmLit] -> ShowS
CmmLit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmmLit] -> ShowS
$cshowList :: [CmmLit] -> ShowS
show :: CmmLit -> String
$cshow :: CmmLit -> String
showsPrec :: Int -> CmmLit -> ShowS
$cshowsPrec :: Int -> 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) = forall doc. IsLine doc => String -> doc
text String
"CmmInt" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Integer
n forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Width
w
  ppr (CmmFloat Rational
n Width
w) = forall doc. IsLine doc => String -> doc
text String
"CmmFloat" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show Rational
n) forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Width
w
  ppr (CmmVec [CmmLit]
xs) = forall doc. IsLine doc => String -> doc
text String
"CmmVec" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr [CmmLit]
xs
  ppr (CmmLabel CLabel
_) = forall doc. IsLine doc => String -> doc
text String
"CmmLabel"
  ppr (CmmLabelOff CLabel
_ Int
_) = forall doc. IsLine doc => String -> doc
text String
"CmmLabelOff"
  ppr (CmmLabelDiffOff CLabel
_ CLabel
_ Int
_ Width
_) = forall doc. IsLine doc => String -> doc
text String
"CmmLabelDiffOff"
  ppr (CmmBlock BlockId
blk) = forall doc. IsLine doc => String -> doc
text String
"CmmBlock" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr BlockId
blk
  ppr CmmLit
CmmHighStackMark = 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 (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 [])          -> 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (CmmType -> CmmType -> Bool
`cmmEqType` CmmType
ty) (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmLit -> CmmType
cmmLitType Platform
platform) [CmmLit]
ls)
                               then Int -> CmmType -> CmmType
cmmVec (Int
1forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. Foldable t => t a -> Int
length [CmmLit]
ls) CmmType
ty
                               else 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 (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
                                            forall (m :: * -> *) a. Monad m => a -> m a
return (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
op' [CmmExpr]
args)
maybeInvertCmmExpr 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
_) = 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)           = 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      = forall r. RegSet r
Set.empty
nullRegSet :: forall r. RegSet r -> Bool
nullRegSet       = forall r. RegSet r -> Bool
Set.null
elemRegSet :: forall r. Ord r => r -> RegSet r -> Bool
elemRegSet       = forall r. Ord r => r -> RegSet r -> Bool
Set.member
extendRegSet :: forall r. Ord r => RegSet r -> r -> RegSet r
extendRegSet     = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.insert
deleteFromRegSet :: forall r. Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.delete
mkRegSet :: forall r. Ord r => [r] -> RegSet r
mkRegSet         = forall r. Ord r => [r] -> RegSet r
Set.fromList
minusRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
minusRegSet      = forall r. Ord r => RegSet r -> RegSet r -> RegSet r
Set.difference
plusRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
plusRegSet       = forall r. Ord r => RegSet r -> RegSet r -> RegSet r
Set.union
timesRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
timesRegSet      = forall r. Ord r => RegSet r -> RegSet r -> RegSet r
Set.intersection
sizeRegSet :: forall r. RegSet r -> Int
sizeRegSet       = forall r. RegSet r -> Int
Set.size
regSetToList :: forall r. RegSet r -> [r]
regSetToList     = 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 = 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 = 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
_)  = 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)          = 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) = 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
_)     = 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (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 (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 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc 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
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"==")
infixMachOp1 (MO_Ne     Width
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"!=")
infixMachOp1 (MO_Shl    Width
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"<<")
infixMachOp1 (MO_U_Shr  Width
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
">>")
infixMachOp1 (MO_U_Ge   Width
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
">=")
infixMachOp1 (MO_U_Le   Width
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"<=")
infixMachOp1 (MO_U_Gt   Width
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => Char -> doc
char Char
'>')
infixMachOp1 (MO_U_Lt   Width
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => Char -> doc
char Char
'<')
infixMachOp1 MachOp
_             = 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 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 (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 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc 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
_)  = forall a. a -> Maybe a
Just (forall doc. IsLine doc => Char -> doc
char Char
'+')
infixMachOp7 (MO_Sub Width
_)  = forall a. a -> Maybe a
Just (forall doc. IsLine doc => Char -> doc
char Char
'-')
infixMachOp7 MachOp
_           = 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 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc 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
_) = forall a. a -> Maybe a
Just (forall doc. IsLine doc => Char -> doc
char Char
'/')
infixMachOp8 (MO_Mul Width
_)    = forall a. a -> Maybe a
Just (forall doc. IsLine doc => Char -> doc
char Char
'*')
infixMachOp8 (MO_U_Rem Width
_)  = forall a. a -> Maybe a
Just (forall doc. IsLine doc => Char -> doc
char Char
'%')
infixMachOp8 MachOp
_             = 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 -> forall doc. IsOutput doc => doc
empty
                                         AlignmentSpec
Unaligned        -> forall doc. IsLine doc => String -> doc
text String
"^"
                                in forall a. Outputable a => a -> SDoc
ppr CmmType
rep forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align_mark forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
brackets (forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)
        CmmReg    CmmReg
reg       -> forall a. Outputable a => a -> SDoc
ppr CmmReg
reg
        CmmRegOff  CmmReg
reg Int
off  -> forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr CmmReg
reg forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Char -> doc
char Char
'+' forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Int -> doc
int Int
off)
        CmmStackSlot Area
a Int
off  -> forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr Area
a   forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Char -> doc
char Char
'+' forall doc. IsLine doc => doc -> doc -> doc
<+> 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 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
y

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

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

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

   | Bool
otherwise = forall doc. IsLine doc => Char -> doc
char Char
'%' forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ppr_op forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
commafy (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform) [CmmExpr]
args))
        where ppr_op :: SDoc
ppr_op = forall doc. IsLine doc => String -> doc
text (forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'_' else Char
c)
                                 (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
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
'&'
            MO_Or     Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
'|'
            MO_Xor    Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
'^'
            MO_Not    Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
'~'
            MO_S_Neg  Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
'-' -- there is no unsigned neg :)
            MachOp
_ -> 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 ->
        forall doc. IsLine doc => [doc] -> doc
hcat [ (if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0 then forall doc. IsLine doc => doc -> doc
parens else forall a. a -> a
id)(forall doc. IsLine doc => Integer -> doc
integer Integer
i)
             , forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Width
rep forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform) forall a b. (a -> b) -> a -> b
$
               forall doc. IsLine doc => doc
space forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Width
rep ]

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

pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 Platform
platform lit :: CmmLit
lit@(CmmLabelOff {}) = 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
iforall a. Eq a => a -> a -> Bool
==Int
0      = forall doc. IsOutput doc => doc
empty
    | Int
iforall a. Ord a => a -> a -> Bool
>=Int
0      = forall doc. IsLine doc => Char -> doc
char Char
'+' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
i
    | Bool
otherwise = forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int (-Int
i)

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