{-# 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,
        isDllConApp,
        stgArgType,
        stgCaseBndrInScope,
        
        StgPprOpts(..),
        panicStgPprOpts, shortStgPprOpts,
        pprStgArg, pprStgExpr, pprStgRhs, pprStgBinding,
        pprGenStgTopBinding, pprStgTopBinding,
        pprGenStgTopBindings, pprStgTopBindings
    ) where
import GHC.Prelude
import GHC.Core     ( AltCon )
import GHC.Types.CostCentre ( CostCentreStack )
import Data.ByteString ( ByteString )
import Data.Data   ( Data )
import Data.List   ( intersperse )
import GHC.Core.DataCon
import GHC.Types.ForeignCall ( ForeignCall )
import GHC.Types.Id
import GHC.Types.Name        ( isDynLinkName )
import GHC.Types.Tickish     ( StgTickish )
import GHC.Types.Var.Set
import GHC.Types.Literal     ( Literal, literalType )
import GHC.Unit.Module       ( Module )
import GHC.Utils.Outputable
import GHC.Platform
import GHC.Core.Ppr(  )
import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
import GHC.Core.TyCon    ( PrimRep(..), TyCon )
import GHC.Core.Type     ( Type )
import GHC.Types.RepType ( typePrimRep1, typePrimRep )
import GHC.Utils.Panic.Plain
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
isDllConApp
  :: Platform
  -> Bool          
  -> Module
  -> DataCon
  -> [StgArg]
  -> Bool
isDllConApp :: Platform -> Bool -> Module -> DataCon -> [StgArg] -> Bool
isDllConApp Platform
platform Bool
ext_dyn_refs Module
this_mod DataCon
con [StgArg]
args
 | Bool -> Bool
not Bool
ext_dyn_refs    = Bool
False
 | Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
    = Platform -> Module -> Name -> Bool
isDynLinkName Platform
platform Module
this_mod (DataCon -> Name
dataConName DataCon
con) Bool -> Bool -> Bool
|| (StgArg -> Bool) -> [StgArg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StgArg -> Bool
is_dll_arg [StgArg]
args
 | Bool
otherwise = Bool
False
  where
    
    
    is_dll_arg :: StgArg -> Bool
    is_dll_arg :: StgArg -> Bool
is_dll_arg (StgVarArg Id
v) =  PrimRep -> Bool
isAddrRep ((() :: Constraint) => UnaryType -> PrimRep
UnaryType -> PrimRep
typePrimRep1 (Id -> UnaryType
idType Id
v))
                             Bool -> Bool -> Bool
&& Platform -> Module -> Name -> Bool
isDynLinkName Platform
platform Module
this_mod (Id -> Name
idName Id
v)
    is_dll_arg StgArg
_             = Bool
False
isAddrRep :: PrimRep -> Bool
isAddrRep :: PrimRep -> Bool
isAddrRep PrimRep
AddrRep     = Bool
True
isAddrRep PrimRep
LiftedRep   = Bool
True
isAddrRep PrimRep
UnliftedRep = Bool
True
isAddrRep PrimRep
_           = Bool
False
stgArgType :: StgArg -> Type
stgArgType :: StgArg -> UnaryType
stgArgType (StgVarArg Id
v)   = Id -> UnaryType
idType Id
v
stgArgType (StgLitArg Literal
lit) = Literal -> UnaryType
literalType Literal
lit
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] 
                [Type]   
  | 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)  
  | StgRhsCon
        CostCentreStack 
                        
                        
                        
                        
        DataCon         
                        
        ConstructorNumber
        [StgTickish]
        [StgArg]        
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
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
_)
  = 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) = [Id] -> DIdSet
mkDVarSet [ Id
id | StgVarArg Id
id <- [StgArg]
args ]
freeVarsOfRhs (StgRhsClosure XRhsClosure pass
fvs CostCentreStack
_ UpdateFlag
_ [BinderP pass]
_ GenStgExpr pass
_) = 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
empty
  ppr (Numbered Int
n) = String -> SDoc
text String
"#" SDoc -> SDoc -> SDoc
<> 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 family XRhsClosure (pass :: StgPass)
type instance XRhsClosure 'Vanilla = NoExtFieldSilent
type instance XRhsClosure 'InferTagged = NoExtFieldSilent
type instance XRhsClosure 'CodeGen = DIdSet
type family XLet (pass :: StgPass)
type instance XLet 'Vanilla = NoExtFieldSilent
type instance XLet 'InferTagged = NoExtFieldSilent
type instance XLet 'CodeGen = NoExtFieldSilent
type family XLetNoEscape (pass :: StgPass)
type instance XLetNoEscape 'Vanilla = NoExtFieldSilent
type instance XLetNoEscape 'InferTagged = NoExtFieldSilent
type instance XLetNoEscape 'CodeGen = NoExtFieldSilent
data UpdateFlag = ReEntrant | Updatable | SingleEntry
instance Outputable UpdateFlag where
    ppr :: UpdateFlag -> SDoc
ppr UpdateFlag
u = Char -> SDoc
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'
isUpdatable :: UpdateFlag -> Bool
isUpdatable :: UpdateFlag -> Bool
isUpdatable UpdateFlag
ReEntrant   = Bool
False
isUpdatable UpdateFlag
SingleEntry = Bool
False
isUpdatable UpdateFlag
Updatable   = Bool
True
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
hsep [BindingSite -> Id -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind Id
bndr, SDoc
equals]) Int
4 (ByteString -> SDoc
pprHsBytes ByteString
str SDoc -> SDoc -> SDoc
<> SDoc
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
hsep [BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind BinderP pass
bndr, SDoc
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
<> SDoc
semi)
   StgRec [(BinderP pass, GenStgRhs pass)]
pairs       -> [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Rec {"
                              , [SDoc] -> SDoc
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
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
hsep [BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind BinderP pass
bndr, SDoc
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
<> SDoc
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
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
<> UnaryType -> SDoc
pprTypeRep (Id -> UnaryType
idType Id
v)
pprTypeRep :: Type -> SDoc
pprTypeRep :: UnaryType -> SDoc
pprTypeRep UnaryType
ty =
    (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressStgReps (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
<> case (() :: Constraint) => UnaryType -> [PrimRep]
UnaryType -> [PrimRep]
typePrimRep UnaryType
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
<> UnaryType -> SDoc
pprTypeRep (Literal -> UnaryType
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
<> 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 [UnaryType]
_ -> [SDoc] -> SDoc
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
brackets ([StgArg] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [StgArg]
args) ]
   StgOpApp StgOp
op [StgArg]
args UnaryType
_   -> [SDoc] -> SDoc
hsep [ StgOp -> SDoc
pprStgOp StgOp
op, SDoc -> SDoc
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
($$)
      ([SDoc] -> SDoc
sep [SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"let" SDoc -> SDoc -> SDoc
<+> XLet pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XLet pass
ext SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"{")
                Int
2 ([SDoc] -> SDoc
hsep [StgPprOpts -> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgBinding pass -> SDoc
pprGenStgBinding StgPprOpts
opts GenStgBinding pass
bind, String -> SDoc
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
sep [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"let" SDoc -> SDoc -> SDoc
<+> XLet pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XLet pass
ext SDoc -> SDoc -> SDoc
<+> String -> SDoc
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
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
sep [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"let-no-escape" SDoc -> SDoc -> SDoc
<+> XLetNoEscape pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XLetNoEscape pass
ext SDoc -> SDoc -> SDoc
<+> String -> SDoc
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
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 -> 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
sep [ [SDoc] -> SDoc
sep [ String -> SDoc
text String
"case"
                   , Int -> SDoc -> SDoc
nest Int
4 ([SDoc] -> SDoc
hsep [ StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr
                                  , SDoc -> SDoc
whenPprDebug (SDoc
dcolon SDoc -> SDoc -> SDoc
<+> AltType -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltType
alt_type)
                                  ])
                   , String -> SDoc
text String
"of"
                   , BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CaseBind BinderP pass
bndr
                   , Char -> SDoc
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
char Char
'}'
             ]
   StgCase GenStgExpr pass
expr BinderP pass
bndr AltType
alt_type [GenStgAlt pass]
alts
      -> [SDoc] -> SDoc
sep [ [SDoc] -> SDoc
sep [ String -> SDoc
text String
"case"
                   , Int -> SDoc -> SDoc
nest Int
4 ([SDoc] -> SDoc
hsep [ StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
expr
                                  , SDoc -> SDoc
whenPprDebug (SDoc
dcolon SDoc -> SDoc -> SDoc
<+> AltType -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltType
alt_type)
                                  ])
                   , String -> SDoc
text String
"of"
                   , BindingSite -> BinderP pass -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CaseBind BinderP pass
bndr, Char -> SDoc
char Char
'{'
                   ]
             , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
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
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
<> SDoc
semi)
  | Bool
otherwise = [SDoc] -> SDoc
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
<> SDoc
semi]
    where
      altPattern :: SDoc
altPattern = [SDoc] -> SDoc
hsep [ AltCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltCon
alt_con
                        , [SDoc] -> SDoc
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
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 UnaryType
_) = 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
text String
"Polymorphic"
  ppr (MultiValAlt Int
n) = String -> SDoc
text String
"MultiAlt" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
  ppr (AlgAlt TyCon
tc)     = String -> SDoc
text String
"Alg"    SDoc -> SDoc -> SDoc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc
  ppr (PrimAlt PrimRep
tc)    = String -> SDoc
text String
"Prim"   SDoc -> SDoc -> SDoc
<+> 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
      -> SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
hsep [ if StgPprOpts -> Bool
stgSccEnabled StgPprOpts
opts then CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
cc else SDoc
empty
                    , (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressStgExts (XRhsClosure pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRhsClosure pass
ext)
                    , Char -> SDoc
char Char
'\\' SDoc -> SDoc -> SDoc
<> UpdateFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr UpdateFlag
upd_flag, SDoc -> SDoc
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
      -> [SDoc] -> SDoc
hcat [ CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
cc, SDoc
space
              , case ConstructorNumber
mid of
                  ConstructorNumber
NoNumber -> SDoc
empty
                  Numbered Int
n -> [SDoc] -> SDoc
hcat [Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n, SDoc
space]
              
              , DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con, String -> SDoc
text String
"! ", SDoc -> SDoc
brackets ([SDoc] -> SDoc
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