{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.Stg.Syntax (
StgArg(..),
GenStgTopBinding(..), GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
GenStgAlt(..), AltType(..),
StgPass(..), BinderP, XRhsClosure, XLet, XLetNoEscape,
NoExtFieldSilent, noExtFieldSilent,
OutputablePass,
UpdateFlag(..), isUpdatable,
ConstructorNumber(..),
StgTopBinding, StgBinding, StgExpr, StgRhs, StgAlt,
CgStgTopBinding, CgStgBinding, CgStgExpr, CgStgRhs, CgStgAlt,
TgStgTopBinding, TgStgBinding, TgStgExpr, TgStgRhs, TgStgAlt,
LlStgTopBinding, LlStgBinding, LlStgExpr, LlStgRhs, LlStgAlt,
InStgArg, InStgTopBinding, InStgBinding, InStgExpr, InStgRhs, InStgAlt,
OutStgArg, OutStgTopBinding, OutStgBinding, OutStgExpr, OutStgRhs, OutStgAlt,
StgOp(..),
stgRhsArity, freeVarsOfRhs,
stgArgType,
stgArgRep,
stgArgRep1,
stgArgRepU,
stgArgRep_maybe,
stgCaseBndrInScope,
StgPprOpts(..),
panicStgPprOpts, shortStgPprOpts,
pprStgArg, pprStgExpr, pprStgRhs, pprStgBinding, pprStgAlt,
pprGenStgTopBinding, pprStgTopBinding,
pprGenStgTopBindings, pprStgTopBindings
) where
import GHC.Prelude
import GHC.Stg.EnforceEpt.TagSig( TagSig )
import GHC.Stg.Lift.Types
import GHC.Types.CostCentre ( CostCentreStack )
import GHC.Core ( AltCon )
import GHC.Core.DataCon
import GHC.Core.TyCon ( PrimRep(..), PrimOrVoidRep(..), TyCon )
import GHC.Core.Type ( Type )
import GHC.Core.Ppr( )
import GHC.Types.ForeignCall ( ForeignCall )
import GHC.Types.Id
import GHC.Types.Tickish ( StgTickish )
import GHC.Types.Var.Set
import GHC.Types.Literal ( Literal, literalType )
import GHC.Types.RepType ( typePrimRep, typePrimRep1, typePrimRepU, typePrimRep_maybe )
import GHC.Utils.Outputable
import GHC.Utils.Panic.Plain
import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
import Data.ByteString ( ByteString )
import Data.Data ( Data )
import Data.List ( intersperse )
data GenStgTopBinding pass
= StgTopLifted (GenStgBinding pass)
| StgTopStringLit Id ByteString
data GenStgBinding pass
= StgNonRec (BinderP pass) (GenStgRhs pass)
| StgRec [(BinderP pass, GenStgRhs pass)]
data StgArg
= StgVarArg Id
| StgLitArg Literal
stgArgType :: StgArg -> Type
stgArgType :: StgArg -> Type
stgArgType (StgVarArg Id
v) = Id -> Type
idType Id
v
stgArgType (StgLitArg Literal
lit) = Literal -> Type
literalType Literal
lit
stgArgRep :: StgArg -> [PrimRep]
stgArgRep :: StgArg -> [PrimRep]
stgArgRep StgArg
ty = HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep (StgArg -> Type
stgArgType StgArg
ty)
stgArgRep_maybe :: StgArg -> Maybe [PrimRep]
stgArgRep_maybe :: StgArg -> Maybe [PrimRep]
stgArgRep_maybe StgArg
ty = Type -> Maybe [PrimRep]
typePrimRep_maybe (StgArg -> Type
stgArgType StgArg
ty)
stgArgRep1 :: StgArg -> PrimOrVoidRep
stgArgRep1 :: StgArg -> PrimOrVoidRep
stgArgRep1 StgArg
ty = HasDebugCallStack => Type -> PrimOrVoidRep
Type -> PrimOrVoidRep
typePrimRep1 (StgArg -> Type
stgArgType StgArg
ty)
stgArgRepU :: StgArg -> PrimRep
stgArgRepU :: StgArg -> PrimRep
stgArgRepU StgArg
ty = HasDebugCallStack => Type -> PrimRep
Type -> PrimRep
typePrimRepU (StgArg -> Type
stgArgType StgArg
ty)
stgCaseBndrInScope :: AltType -> Bool -> Bool
stgCaseBndrInScope :: AltType -> Bool -> Bool
stgCaseBndrInScope AltType
alt_ty Bool
unarised =
case AltType
alt_ty of
AlgAlt TyCon
_ -> Bool
True
PrimAlt PrimRep
_ -> Bool
True
MultiValAlt Int
_ -> Bool -> Bool
not Bool
unarised
AltType
PolyAlt -> Bool
True
data GenStgExpr pass
= StgApp
Id
[StgArg]
| StgLit Literal
| StgConApp DataCon
ConstructorNumber
[StgArg]
[[PrimRep]]
| StgOpApp StgOp
[StgArg]
Type
| StgCase
(GenStgExpr pass)
(BinderP pass)
AltType
[GenStgAlt pass]
| StgLet
(XLet pass)
(GenStgBinding pass)
(GenStgExpr pass)
| StgLetNoEscape
(XLetNoEscape pass)
(GenStgBinding pass)
(GenStgExpr pass)
| StgTick
StgTickish
(GenStgExpr pass)
data GenStgRhs pass
= StgRhsClosure
(XRhsClosure pass)
CostCentreStack
!UpdateFlag
[BinderP pass]
(GenStgExpr pass)
Type
| StgRhsCon
CostCentreStack
DataCon
ConstructorNumber
[StgTickish]
[StgArg]
Type
data NoExtFieldSilent = NoExtFieldSilent
deriving (Typeable NoExtFieldSilent
Typeable NoExtFieldSilent =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NoExtFieldSilent -> c NoExtFieldSilent)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NoExtFieldSilent)
-> (NoExtFieldSilent -> Constr)
-> (NoExtFieldSilent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NoExtFieldSilent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NoExtFieldSilent))
-> ((forall b. Data b => b -> b)
-> NoExtFieldSilent -> NoExtFieldSilent)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r)
-> (forall u.
(forall d. Data d => d -> u) -> NoExtFieldSilent -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> NoExtFieldSilent -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent)
-> Data NoExtFieldSilent
NoExtFieldSilent -> Constr
NoExtFieldSilent -> DataType
(forall b. Data b => b -> b)
-> NoExtFieldSilent -> NoExtFieldSilent
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> NoExtFieldSilent -> u
forall u. (forall d. Data d => d -> u) -> NoExtFieldSilent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NoExtFieldSilent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NoExtFieldSilent -> c NoExtFieldSilent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NoExtFieldSilent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NoExtFieldSilent)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NoExtFieldSilent -> c NoExtFieldSilent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NoExtFieldSilent -> c NoExtFieldSilent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NoExtFieldSilent
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NoExtFieldSilent
$ctoConstr :: NoExtFieldSilent -> Constr
toConstr :: NoExtFieldSilent -> Constr
$cdataTypeOf :: NoExtFieldSilent -> DataType
dataTypeOf :: NoExtFieldSilent -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NoExtFieldSilent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NoExtFieldSilent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NoExtFieldSilent)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NoExtFieldSilent)
$cgmapT :: (forall b. Data b => b -> b)
-> NoExtFieldSilent -> NoExtFieldSilent
gmapT :: (forall b. Data b => b -> b)
-> NoExtFieldSilent -> NoExtFieldSilent
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NoExtFieldSilent -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NoExtFieldSilent -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NoExtFieldSilent -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> NoExtFieldSilent -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> NoExtFieldSilent -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NoExtFieldSilent -> m NoExtFieldSilent
Data, NoExtFieldSilent -> NoExtFieldSilent -> Bool
(NoExtFieldSilent -> NoExtFieldSilent -> Bool)
-> (NoExtFieldSilent -> NoExtFieldSilent -> Bool)
-> Eq NoExtFieldSilent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
== :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
$c/= :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
/= :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
Eq, Eq NoExtFieldSilent
Eq NoExtFieldSilent =>
(NoExtFieldSilent -> NoExtFieldSilent -> Ordering)
-> (NoExtFieldSilent -> NoExtFieldSilent -> Bool)
-> (NoExtFieldSilent -> NoExtFieldSilent -> Bool)
-> (NoExtFieldSilent -> NoExtFieldSilent -> Bool)
-> (NoExtFieldSilent -> NoExtFieldSilent -> Bool)
-> (NoExtFieldSilent -> NoExtFieldSilent -> NoExtFieldSilent)
-> (NoExtFieldSilent -> NoExtFieldSilent -> NoExtFieldSilent)
-> Ord NoExtFieldSilent
NoExtFieldSilent -> NoExtFieldSilent -> Bool
NoExtFieldSilent -> NoExtFieldSilent -> Ordering
NoExtFieldSilent -> NoExtFieldSilent -> NoExtFieldSilent
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 :: NoExtFieldSilent -> NoExtFieldSilent -> Ordering
compare :: NoExtFieldSilent -> NoExtFieldSilent -> Ordering
$c< :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
< :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
$c<= :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
<= :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
$c> :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
> :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
$c>= :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
>= :: NoExtFieldSilent -> NoExtFieldSilent -> Bool
$cmax :: NoExtFieldSilent -> NoExtFieldSilent -> NoExtFieldSilent
max :: NoExtFieldSilent -> NoExtFieldSilent -> NoExtFieldSilent
$cmin :: NoExtFieldSilent -> NoExtFieldSilent -> NoExtFieldSilent
min :: NoExtFieldSilent -> NoExtFieldSilent -> NoExtFieldSilent
Ord)
instance Outputable NoExtFieldSilent where
ppr :: NoExtFieldSilent -> SDoc
ppr NoExtFieldSilent
_ = SDoc
forall doc. IsOutput doc => doc
empty
noExtFieldSilent :: NoExtFieldSilent
noExtFieldSilent :: NoExtFieldSilent
noExtFieldSilent = NoExtFieldSilent
NoExtFieldSilent
stgRhsArity :: StgRhs -> Int
stgRhsArity :: StgRhs -> Int
stgRhsArity (StgRhsClosure XRhsClosure 'Vanilla
_ CostCentreStack
_ UpdateFlag
_ [BinderP 'Vanilla]
bndrs GenStgExpr 'Vanilla
_ Type
_)
= Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert ((Id -> Bool) -> [Id] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Id -> Bool
isId [Id]
[BinderP 'Vanilla]
bndrs) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Id] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Id]
[BinderP 'Vanilla]
bndrs
stgRhsArity (StgRhsCon {}) = Int
0
freeVarsOfRhs :: (XRhsClosure pass ~ DIdSet) => GenStgRhs pass -> DIdSet
freeVarsOfRhs :: forall (pass :: StgPass).
(XRhsClosure pass ~ DIdSet) =>
GenStgRhs pass -> DIdSet
freeVarsOfRhs (StgRhsCon CostCentreStack
_ DataCon
_ ConstructorNumber
_ [StgTickish]
_ [StgArg]
args Type
_) = [Id] -> DIdSet
mkDVarSet [ Id
id | StgVarArg Id
id <- [StgArg]
args ]
freeVarsOfRhs (StgRhsClosure XRhsClosure pass
fvs CostCentreStack
_ UpdateFlag
_ [BinderP pass]
_ GenStgExpr pass
_ Type
_) = DIdSet
XRhsClosure pass
fvs
data GenStgAlt pass = GenStgAlt
{ forall (pass :: StgPass). GenStgAlt pass -> AltCon
alt_con :: !AltCon
, forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
alt_bndrs :: ![BinderP pass]
, forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
alt_rhs :: !(GenStgExpr pass)
}
data AltType
= PolyAlt
| MultiValAlt Int
| AlgAlt TyCon
| PrimAlt PrimRep
type StgTopBinding = GenStgTopBinding 'Vanilla
type StgBinding = GenStgBinding 'Vanilla
type StgExpr = GenStgExpr 'Vanilla
type StgRhs = GenStgRhs 'Vanilla
type StgAlt = GenStgAlt 'Vanilla
type LlStgTopBinding = GenStgTopBinding 'LiftLams
type LlStgBinding = GenStgBinding 'LiftLams
type LlStgExpr = GenStgExpr 'LiftLams
type LlStgRhs = GenStgRhs 'LiftLams
type LlStgAlt = GenStgAlt 'LiftLams
type CgStgTopBinding = GenStgTopBinding 'CodeGen
type CgStgBinding = GenStgBinding 'CodeGen
type CgStgExpr = GenStgExpr 'CodeGen
type CgStgRhs = GenStgRhs 'CodeGen
type CgStgAlt = GenStgAlt 'CodeGen
type TgStgTopBinding = GenStgTopBinding 'CodeGen
type TgStgBinding = GenStgBinding 'CodeGen
type TgStgExpr = GenStgExpr 'CodeGen
type TgStgRhs = GenStgRhs 'CodeGen
type TgStgAlt = GenStgAlt 'CodeGen
type InStgTopBinding = StgTopBinding
type InStgBinding = StgBinding
type InStgArg = StgArg
type InStgExpr = StgExpr
type InStgRhs = StgRhs
type InStgAlt = StgAlt
type OutStgTopBinding = StgTopBinding
type OutStgBinding = StgBinding
type OutStgArg = StgArg
type OutStgExpr = StgExpr
type OutStgRhs = StgRhs
type OutStgAlt = StgAlt
data ConstructorNumber =
NoNumber | Numbered Int
instance Outputable ConstructorNumber where
ppr :: ConstructorNumber -> SDoc
ppr ConstructorNumber
NoNumber = SDoc
forall doc. IsOutput doc => doc
empty
ppr (Numbered Int
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
data StgPass
= Vanilla
| LiftLams
| InferTaggedBinders
| InferTagged
| CodeGen
type family BinderP (pass :: StgPass)
type instance BinderP 'Vanilla = Id
type instance BinderP 'CodeGen = Id
type instance BinderP 'InferTagged = Id
type instance BinderP 'InferTaggedBinders = (Id, TagSig)
type instance BinderP 'LiftLams = BinderInfo
type family XRhsClosure (pass :: StgPass)
type instance XRhsClosure 'Vanilla = NoExtFieldSilent
type instance XRhsClosure 'LiftLams = DIdSet
type instance XRhsClosure 'InferTagged = NoExtFieldSilent
type instance XRhsClosure 'InferTaggedBinders = XRhsClosure 'CodeGen
type instance XRhsClosure 'CodeGen = DIdSet
type family XLet (pass :: StgPass)
type instance XLet 'Vanilla = NoExtFieldSilent
type instance XLet 'LiftLams = Skeleton
type instance XLet 'InferTagged = NoExtFieldSilent
type instance XLet 'InferTaggedBinders = XLet 'CodeGen
type instance XLet 'CodeGen = NoExtFieldSilent
type family XLetNoEscape (pass :: StgPass)
type instance XLetNoEscape 'Vanilla = NoExtFieldSilent
type instance XLetNoEscape 'LiftLams = Skeleton
type instance XLetNoEscape 'InferTagged = NoExtFieldSilent
type instance XLetNoEscape 'InferTaggedBinders = XLetNoEscape 'CodeGen
type instance XLetNoEscape 'CodeGen = NoExtFieldSilent
data UpdateFlag
= ReEntrant
| Updatable
| SingleEntry
| JumpedTo
deriving (Int -> UpdateFlag -> ShowS
[UpdateFlag] -> ShowS
UpdateFlag -> String
(Int -> UpdateFlag -> ShowS)
-> (UpdateFlag -> String)
-> ([UpdateFlag] -> ShowS)
-> Show UpdateFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateFlag -> ShowS
showsPrec :: Int -> UpdateFlag -> ShowS
$cshow :: UpdateFlag -> String
show :: UpdateFlag -> String
$cshowList :: [UpdateFlag] -> ShowS
showList :: [UpdateFlag] -> ShowS
Show,UpdateFlag -> UpdateFlag -> Bool
(UpdateFlag -> UpdateFlag -> Bool)
-> (UpdateFlag -> UpdateFlag -> Bool) -> Eq UpdateFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateFlag -> UpdateFlag -> Bool
== :: UpdateFlag -> UpdateFlag -> Bool
$c/= :: UpdateFlag -> UpdateFlag -> Bool
/= :: UpdateFlag -> UpdateFlag -> Bool
Eq)
instance Outputable UpdateFlag where
ppr :: UpdateFlag -> SDoc
ppr UpdateFlag
u = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char (Char -> SDoc) -> Char -> SDoc
forall a b. (a -> b) -> a -> b
$ case UpdateFlag
u of
UpdateFlag
ReEntrant -> Char
'r'
UpdateFlag
Updatable -> Char
'u'
UpdateFlag
SingleEntry -> Char
's'
UpdateFlag
JumpedTo -> Char
'j'
isUpdatable :: UpdateFlag -> Bool
isUpdatable :: UpdateFlag -> Bool
isUpdatable UpdateFlag
ReEntrant = Bool
False
isUpdatable UpdateFlag
SingleEntry = Bool
False
isUpdatable UpdateFlag
Updatable = Bool
True
isUpdatable UpdateFlag
JumpedTo = Bool
False
data StgOp
= StgPrimOp PrimOp
| StgPrimCallOp PrimCall
| StgFCallOp ForeignCall Type
type OutputablePass pass =
( Outputable (XLet pass)
, Outputable (XLetNoEscape pass)
, Outputable (XRhsClosure pass)
, OutputableBndr (BinderP pass)
)
data StgPprOpts = StgPprOpts
{ StgPprOpts -> Bool
stgSccEnabled :: !Bool
}
panicStgPprOpts :: StgPprOpts
panicStgPprOpts :: StgPprOpts
panicStgPprOpts = StgPprOpts
{ stgSccEnabled :: Bool
stgSccEnabled = Bool
True
}
shortStgPprOpts :: StgPprOpts
shortStgPprOpts :: StgPprOpts
shortStgPprOpts = StgPprOpts
{ stgSccEnabled :: Bool
stgSccEnabled = Bool
False
}
pprGenStgTopBinding
:: OutputablePass pass => StgPprOpts -> GenStgTopBinding pass -> SDoc
pprGenStgTopBinding :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgTopBinding pass -> SDoc
pprGenStgTopBinding StgPprOpts
opts GenStgTopBinding pass
b = case GenStgTopBinding pass
b of
StgTopStringLit Id
bndr ByteString
str -> SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [BindingSite -> Id -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind Id
bndr, SDoc
forall doc. IsLine doc => doc
equals]) Int
4 (ByteString -> SDoc
pprHsBytes ByteString
str SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi)
StgTopLifted GenStgBinding pass
bind -> StgPprOpts -> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding StgPprOpts
opts GenStgBinding pass
bind
pprGenStgBinding :: OutputablePass pass => StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding StgPprOpts
opts GenStgBinding pass
b = case GenStgBinding pass
b of
StgNonRec BinderP pass
bndr GenStgRhs pass
rhs -> SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind BinderP pass
bndr, SDoc
forall doc. IsLine doc => doc
equals]) Int
4 (StgPprOpts -> GenStgRhs pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhs StgPprOpts
opts GenStgRhs pass
rhs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi)
StgRec [(BinderP pass, GenStgRhs pass)]
pairs -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rec {"
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse SDoc
blankLine (((BinderP pass, GenStgRhs pass) -> SDoc)
-> [(BinderP pass, GenStgRhs pass)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (BinderP pass, GenStgRhs pass) -> SDoc
ppr_bind [(BinderP pass, GenStgRhs pass)]
pairs))
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"end Rec }" ]
where
ppr_bind :: (BinderP pass, GenStgRhs pass) -> SDoc
ppr_bind (BinderP pass
bndr, GenStgRhs pass
expr)
= SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind BinderP pass
bndr, SDoc
forall doc. IsLine doc => doc
equals])
Int
4 (StgPprOpts -> GenStgRhs pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhs StgPprOpts
opts GenStgRhs pass
expr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi)
instance OutputablePass pass => Outputable (GenStgBinding pass) where
ppr :: GenStgBinding pass -> SDoc
ppr = StgPprOpts -> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding StgPprOpts
panicStgPprOpts
pprGenStgTopBindings :: (OutputablePass pass) => StgPprOpts -> [GenStgTopBinding pass] -> SDoc
pprGenStgTopBindings :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> [GenStgTopBinding pass] -> SDoc
pprGenStgTopBindings StgPprOpts
opts [GenStgTopBinding pass]
binds
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse SDoc
blankLine ((GenStgTopBinding pass -> SDoc)
-> [GenStgTopBinding pass] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (StgPprOpts -> GenStgTopBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgTopBinding pass -> SDoc
pprGenStgTopBinding StgPprOpts
opts) [GenStgTopBinding pass]
binds)
pprStgBinding :: OutputablePass pass => StgPprOpts -> GenStgBinding pass -> SDoc
pprStgBinding :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprStgBinding = StgPprOpts -> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding
pprStgTopBinding :: OutputablePass pass => StgPprOpts -> GenStgTopBinding pass -> SDoc
pprStgTopBinding :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgTopBinding pass -> SDoc
pprStgTopBinding = StgPprOpts -> GenStgTopBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgTopBinding pass -> SDoc
pprGenStgTopBinding
pprStgTopBindings :: OutputablePass pass => StgPprOpts -> [GenStgTopBinding pass] -> SDoc
pprStgTopBindings :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> [GenStgTopBinding pass] -> SDoc
pprStgTopBindings = StgPprOpts -> [GenStgTopBinding pass] -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> [GenStgTopBinding pass] -> SDoc
pprGenStgTopBindings
pprIdWithRep :: Id -> SDoc
pprIdWithRep :: Id -> SDoc
pprIdWithRep Id
v = Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Type -> SDoc
pprTypeRep (Id -> Type
idType Id
v)
pprTypeRep :: Type -> SDoc
pprTypeRep :: Type -> SDoc
pprTypeRep Type
ty =
(SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressStgReps (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
':' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> case HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
ty of
[PrimRep
r] -> PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r
[PrimRep]
r -> [PrimRep] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [PrimRep]
r
instance Outputable StgArg where
ppr :: StgArg -> SDoc
ppr = StgArg -> SDoc
pprStgArg
pprStgArg :: StgArg -> SDoc
pprStgArg :: StgArg -> SDoc
pprStgArg (StgVarArg Id
var) = Id -> SDoc
pprIdWithRep Id
var
pprStgArg (StgLitArg Literal
con) = Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Type -> SDoc
pprTypeRep (Literal -> Type
literalType Literal
con)
instance OutputablePass pass => Outputable (GenStgExpr pass) where
ppr :: GenStgExpr pass -> SDoc
ppr = StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
panicStgPprOpts
pprStgExpr :: OutputablePass pass => StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
e = case GenStgExpr pass
e of
StgLit Literal
lit -> Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
lit
StgApp Id
func [StgArg]
args
| [StgArg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StgArg]
args
, Just TagSig
sig <- Id -> Maybe TagSig
idTagSig_maybe Id
func
-> Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
func SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> TagSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr TagSig
sig
| Bool
otherwise -> SDoc -> Int -> SDoc -> SDoc
hang (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
func) Int
4 ([StgArg] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [StgArg]
args)
StgConApp DataCon
con ConstructorNumber
n [StgArg]
args [[PrimRep]]
_ -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con, ConstructorNumber -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConstructorNumber
n, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([StgArg] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [StgArg]
args) ]
StgOpApp StgOp
op [StgArg]
args Type
_ -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ StgOp -> SDoc
pprStgOp StgOp
op, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([StgArg] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [StgArg]
args)]
StgLet XLet pass
ext GenStgBinding pass
bind expr :: GenStgExpr pass
expr@StgLet{} -> SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
($$)
([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"let" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> XLet pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XLet pass
ext SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{")
Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [StgPprOpts -> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding StgPprOpts
opts GenStgBinding pass
bind, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"} in"])])
(StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr)
StgLet XLet pass
ext GenStgBinding pass
bind GenStgExpr pass
expr
-> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"let" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> XLet pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XLet pass
ext SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{")
Int
2 (StgPprOpts -> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding StgPprOpts
opts GenStgBinding pass
bind)
, SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"} in ") Int
2 (StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr)
]
StgLetNoEscape XLetNoEscape pass
ext GenStgBinding pass
bind GenStgExpr pass
expr
-> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"let-no-escape" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> XLetNoEscape pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XLetNoEscape pass
ext SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{")
Int
2 (StgPprOpts -> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding StgPprOpts
opts GenStgBinding pass
bind)
, SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"} in ") Int
2 (StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr)
]
StgTick StgTickish
tickish GenStgExpr pass
expr -> (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressTicks ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr
Bool
False -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ StgTickish -> SDoc
forall a. Outputable a => a -> SDoc
ppr StgTickish
tickish, StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr ]
StgCase GenStgExpr pass
expr BinderP pass
bndr AltType
alt_type [GenStgAlt pass
alt]
-> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"case"
, Int -> SDoc -> SDoc
nest Int
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AltType -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltType
alt_type)
])
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of"
, BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CaseBind BinderP pass
bndr
, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'{'
]
, StgPprOpts -> Bool -> GenStgAlt pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> Bool -> GenStgAlt pass -> SDoc
pprStgAlt StgPprOpts
opts Bool
False GenStgAlt pass
alt
, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'}'
]
StgCase GenStgExpr pass
expr BinderP pass
bndr AltType
alt_type [GenStgAlt pass]
alts
-> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"case"
, Int -> SDoc -> SDoc
nest Int
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AltType -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltType
alt_type)
])
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of"
, BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CaseBind BinderP pass
bndr, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'{'
]
, Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenStgAlt pass -> SDoc) -> [GenStgAlt pass] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (StgPprOpts -> Bool -> GenStgAlt pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> Bool -> GenStgAlt pass -> SDoc
pprStgAlt StgPprOpts
opts Bool
True) [GenStgAlt pass]
alts))
, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'}'
]
pprStgAlt :: OutputablePass pass => StgPprOpts -> Bool -> GenStgAlt pass -> SDoc
pprStgAlt :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> Bool -> GenStgAlt pass -> SDoc
pprStgAlt StgPprOpts
opts Bool
indent GenStgAlt{AltCon
alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
alt_con :: AltCon
alt_con, [BinderP pass]
alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
alt_bndrs :: [BinderP pass]
alt_bndrs, GenStgExpr pass
alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
alt_rhs :: GenStgExpr pass
alt_rhs}
| Bool
indent = SDoc -> Int -> SDoc -> SDoc
hang SDoc
altPattern Int
4 (StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
alt_rhs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi)
| Bool
otherwise = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
altPattern, StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
alt_rhs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi]
where
altPattern :: SDoc
altPattern = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ AltCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltCon
alt_con
, [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((BinderP pass -> SDoc) -> [BinderP pass] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CasePatBind) [BinderP pass]
alt_bndrs)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"->"
]
pprStgOp :: StgOp -> SDoc
pprStgOp :: StgOp -> SDoc
pprStgOp (StgPrimOp PrimOp
op) = PrimOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimOp
op
pprStgOp (StgPrimCallOp PrimCall
op)= PrimCall -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimCall
op
pprStgOp (StgFCallOp ForeignCall
op Type
_) = ForeignCall -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignCall
op
instance Outputable StgOp where
ppr :: StgOp -> SDoc
ppr = StgOp -> SDoc
pprStgOp
instance Outputable AltType where
ppr :: AltType -> SDoc
ppr AltType
PolyAlt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Polymorphic"
ppr (MultiValAlt Int
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"MultiAlt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
ppr (AlgAlt TyCon
tc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Alg" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc
ppr (PrimAlt PrimRep
tc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Prim" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
tc
pprStgRhs :: OutputablePass pass => StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhs :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhs StgPprOpts
opts GenStgRhs pass
rhs = case GenStgRhs pass
rhs of
StgRhsClosure XRhsClosure pass
ext CostCentreStack
cc UpdateFlag
upd_flag [BinderP pass]
args GenStgExpr pass
body Type
_
-> SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ if StgPprOpts -> Bool
stgSccEnabled StgPprOpts
opts then CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
cc else SDoc
forall doc. IsOutput doc => doc
empty
, (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressStgExts (XRhsClosure pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRhsClosure pass
ext)
, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\\' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UpdateFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr UpdateFlag
upd_flag, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([BinderP pass] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [BinderP pass]
args)
])
Int
4 (StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
body)
StgRhsCon CostCentreStack
cc DataCon
con ConstructorNumber
mid [StgTickish]
_ticks [StgArg]
args Type
_
-> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ if StgPprOpts -> Bool
stgSccEnabled StgPprOpts
opts then CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
cc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
space else SDoc
forall doc. IsOutput doc => doc
empty
, case ConstructorNumber
mid of
ConstructorNumber
NoNumber -> SDoc
forall doc. IsOutput doc => doc
empty
Numbered Int
n -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n, SDoc
forall doc. IsLine doc => doc
space]
, DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"! ", SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((StgArg -> SDoc) -> [StgArg] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map StgArg -> SDoc
pprStgArg [StgArg]
args))]
instance OutputablePass pass => Outputable (GenStgRhs pass) where
ppr :: GenStgRhs pass -> SDoc
ppr = StgPprOpts -> GenStgRhs pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhs StgPprOpts
panicStgPprOpts