{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
module GHC.Types.Tickish (
GenTickish(..),
CoreTickish, StgTickish, CmmTickish,
XTickishId,
tickishCounts,
TickishScoping(..),
tickishScoped,
tickishScopesLike,
tickishFloatable,
tickishCanSplit,
mkNoCount,
mkNoScope,
tickishIsCode,
isProfTick,
TickishPlacement(..),
tickishPlace,
tickishContains
) where
import GHC.Prelude
import GHC.Core.Type
import GHC.Unit.Module
import GHC.Types.CostCentre
import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
import GHC.Types.Var
import GHC.Utils.Panic
import Language.Haskell.Syntax.Extension ( NoExtField )
import Data.Data
import GHC.Utils.Outputable (Outputable (ppr), text)
data TickishPass
= TickishPassCore
| TickishPassStg
| TickishPassCmm
type family XBreakpoint (pass :: TickishPass)
type instance XBreakpoint 'TickishPassCore = NoExtField
type instance XBreakpoint 'TickishPassStg = Type
type instance XBreakpoint 'TickishPassCmm = NoExtField
type family XTickishId (pass :: TickishPass)
type instance XTickishId 'TickishPassCore = Id
type instance XTickishId 'TickishPassStg = Id
type instance XTickishId 'TickishPassCmm = NoExtField
type CoreTickish = GenTickish 'TickishPassCore
type StgTickish = GenTickish 'TickishPassStg
type CmmTickish = GenTickish 'TickishPassCmm
data GenTickish pass =
ProfNote {
forall (pass :: TickishPass). GenTickish pass -> CostCentre
profNoteCC :: CostCentre,
forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteCount :: !Bool,
forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteScope :: !Bool
}
| HpcTick {
forall (pass :: TickishPass). GenTickish pass -> Module
tickModule :: Module,
forall (pass :: TickishPass). GenTickish pass -> Int
tickId :: !Int
}
| Breakpoint
{ forall (pass :: TickishPass). GenTickish pass -> XBreakpoint pass
breakpointExt :: XBreakpoint pass
, forall (pass :: TickishPass). GenTickish pass -> Int
breakpointId :: !Int
, forall (pass :: TickishPass). GenTickish pass -> [XTickishId pass]
breakpointFVs :: [XTickishId pass]
}
| SourceNote
{ forall (pass :: TickishPass). GenTickish pass -> RealSrcSpan
sourceSpan :: RealSrcSpan
, forall (pass :: TickishPass). GenTickish pass -> String
sourceName :: String
}
deriving instance Eq (GenTickish 'TickishPassCore)
deriving instance Ord (GenTickish 'TickishPassCore)
deriving instance Data (GenTickish 'TickishPassCore)
deriving instance Data (GenTickish 'TickishPassStg)
deriving instance Eq (GenTickish 'TickishPassCmm)
deriving instance Ord (GenTickish 'TickishPassCmm)
deriving instance Data (GenTickish 'TickishPassCmm)
tickishCounts :: GenTickish pass -> Bool
tickishCounts :: forall (pass :: TickishPass). GenTickish pass -> Bool
tickishCounts n :: GenTickish pass
n@ProfNote{} = GenTickish pass -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteCount GenTickish pass
n
tickishCounts HpcTick{} = Bool
True
tickishCounts Breakpoint{} = Bool
True
tickishCounts GenTickish pass
_ = Bool
False
data TickishScoping =
NoScope
| SoftScope
| CostCentreScope
deriving (TickishScoping -> TickishScoping -> Bool
(TickishScoping -> TickishScoping -> Bool)
-> (TickishScoping -> TickishScoping -> Bool) -> Eq TickishScoping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TickishScoping -> TickishScoping -> Bool
== :: TickishScoping -> TickishScoping -> Bool
$c/= :: TickishScoping -> TickishScoping -> Bool
/= :: TickishScoping -> TickishScoping -> Bool
Eq)
tickishScoped :: GenTickish pass -> TickishScoping
tickishScoped :: forall (pass :: TickishPass). GenTickish pass -> TickishScoping
tickishScoped n :: GenTickish pass
n@ProfNote{}
| GenTickish pass -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteScope GenTickish pass
n = TickishScoping
CostCentreScope
| Bool
otherwise = TickishScoping
NoScope
tickishScoped HpcTick{} = TickishScoping
NoScope
tickishScoped Breakpoint{} = TickishScoping
CostCentreScope
tickishScoped SourceNote{} = TickishScoping
SoftScope
tickishScopesLike :: GenTickish pass -> TickishScoping -> Bool
tickishScopesLike :: forall (pass :: TickishPass).
GenTickish pass -> TickishScoping -> Bool
tickishScopesLike GenTickish pass
t TickishScoping
scope = GenTickish pass -> TickishScoping
forall (pass :: TickishPass). GenTickish pass -> TickishScoping
tickishScoped GenTickish pass
t TickishScoping -> TickishScoping -> Bool
`like` TickishScoping
scope
where TickishScoping
NoScope like :: TickishScoping -> TickishScoping -> Bool
`like` TickishScoping
_ = Bool
True
TickishScoping
_ `like` TickishScoping
NoScope = Bool
False
TickishScoping
SoftScope `like` TickishScoping
_ = Bool
True
TickishScoping
_ `like` TickishScoping
SoftScope = Bool
False
TickishScoping
CostCentreScope `like` TickishScoping
_ = Bool
True
tickishFloatable :: GenTickish pass -> Bool
tickishFloatable :: forall (pass :: TickishPass). GenTickish pass -> Bool
tickishFloatable GenTickish pass
t = GenTickish pass
t GenTickish pass -> TickishScoping -> Bool
forall (pass :: TickishPass).
GenTickish pass -> TickishScoping -> Bool
`tickishScopesLike` TickishScoping
SoftScope Bool -> Bool -> Bool
&& Bool -> Bool
not (GenTickish pass -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishCounts GenTickish pass
t)
tickishCanSplit :: GenTickish pass -> Bool
tickishCanSplit :: forall (pass :: TickishPass). GenTickish pass -> Bool
tickishCanSplit ProfNote{profNoteScope :: forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteScope = Bool
True, profNoteCount :: forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteCount = Bool
True}
= Bool
True
tickishCanSplit GenTickish pass
_ = Bool
False
mkNoCount :: GenTickish pass -> GenTickish pass
mkNoCount :: forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
mkNoCount GenTickish pass
n | Bool -> Bool
not (GenTickish pass -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishCounts GenTickish pass
n) = GenTickish pass
n
| Bool -> Bool
not (GenTickish pass -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishCanSplit GenTickish pass
n) = String -> GenTickish pass
forall a. HasCallStack => String -> a
panic String
"mkNoCount: Cannot split!"
mkNoCount n :: GenTickish pass
n@ProfNote{} = GenTickish pass
n {profNoteCount = False}
mkNoCount GenTickish pass
_ = String -> GenTickish pass
forall a. HasCallStack => String -> a
panic String
"mkNoCount: Undefined split!"
mkNoScope :: GenTickish pass -> GenTickish pass
mkNoScope :: forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
mkNoScope GenTickish pass
n | GenTickish pass -> TickishScoping
forall (pass :: TickishPass). GenTickish pass -> TickishScoping
tickishScoped GenTickish pass
n TickishScoping -> TickishScoping -> Bool
forall a. Eq a => a -> a -> Bool
== TickishScoping
NoScope = GenTickish pass
n
| Bool -> Bool
not (GenTickish pass -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishCanSplit GenTickish pass
n) = String -> GenTickish pass
forall a. HasCallStack => String -> a
panic String
"mkNoScope: Cannot split!"
mkNoScope n :: GenTickish pass
n@ProfNote{} = GenTickish pass
n {profNoteScope = False}
mkNoScope GenTickish pass
_ = String -> GenTickish pass
forall a. HasCallStack => String -> a
panic String
"mkNoScope: Undefined split!"
tickishIsCode :: GenTickish pass -> Bool
tickishIsCode :: forall (pass :: TickishPass). GenTickish pass -> Bool
tickishIsCode SourceNote{} = Bool
False
tickishIsCode GenTickish pass
_tickish = Bool
True
isProfTick :: GenTickish pass -> Bool
isProfTick :: forall (pass :: TickishPass). GenTickish pass -> Bool
isProfTick ProfNote{} = Bool
True
isProfTick GenTickish pass
_ = Bool
False
data TickishPlacement =
PlaceRuntime
| PlaceNonLam
| PlaceCostCentre
deriving (TickishPlacement -> TickishPlacement -> Bool
(TickishPlacement -> TickishPlacement -> Bool)
-> (TickishPlacement -> TickishPlacement -> Bool)
-> Eq TickishPlacement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TickishPlacement -> TickishPlacement -> Bool
== :: TickishPlacement -> TickishPlacement -> Bool
$c/= :: TickishPlacement -> TickishPlacement -> Bool
/= :: TickishPlacement -> TickishPlacement -> Bool
Eq,Int -> TickishPlacement -> ShowS
[TickishPlacement] -> ShowS
TickishPlacement -> String
(Int -> TickishPlacement -> ShowS)
-> (TickishPlacement -> String)
-> ([TickishPlacement] -> ShowS)
-> Show TickishPlacement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickishPlacement -> ShowS
showsPrec :: Int -> TickishPlacement -> ShowS
$cshow :: TickishPlacement -> String
show :: TickishPlacement -> String
$cshowList :: [TickishPlacement] -> ShowS
showList :: [TickishPlacement] -> ShowS
Show)
instance Outputable TickishPlacement where
ppr :: TickishPlacement -> SDoc
ppr = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc)
-> (TickishPlacement -> String) -> TickishPlacement -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickishPlacement -> String
forall a. Show a => a -> String
show
tickishPlace :: GenTickish pass -> TickishPlacement
tickishPlace :: forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
tickishPlace n :: GenTickish pass
n@ProfNote{}
| GenTickish pass -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteCount GenTickish pass
n = TickishPlacement
PlaceRuntime
| Bool
otherwise = TickishPlacement
PlaceCostCentre
tickishPlace HpcTick{} = TickishPlacement
PlaceRuntime
tickishPlace Breakpoint{} = TickishPlacement
PlaceRuntime
tickishPlace SourceNote{} = TickishPlacement
PlaceNonLam
tickishContains :: Eq (GenTickish pass)
=> GenTickish pass -> GenTickish pass -> Bool
tickishContains :: forall (pass :: TickishPass).
Eq (GenTickish pass) =>
GenTickish pass -> GenTickish pass -> Bool
tickishContains (SourceNote RealSrcSpan
sp1 String
n1) (SourceNote RealSrcSpan
sp2 String
n2)
= RealSrcSpan -> RealSrcSpan -> Bool
containsSpan RealSrcSpan
sp1 RealSrcSpan
sp2 Bool -> Bool -> Bool
&& String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2
tickishContains GenTickish pass
t1 GenTickish pass
t2
= GenTickish pass
t1 GenTickish pass -> GenTickish pass -> Bool
forall a. Eq a => a -> a -> Bool
== GenTickish pass
t2