Commit 7de3532f authored by Luite Stegeman's avatar Luite Stegeman Committed by Marge Bot
Browse files

Transfer tickish things to GHC.Types.Tickish

Metric Increase:
    MultiLayerModules
parent 0107f356
......@@ -39,13 +39,13 @@ import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Core
import GHC.Data.FastString ( nilFS, mkFastString )
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Cmm.Ppr.Expr ( pprExpr )
import GHC.Types.SrcLoc
import GHC.Types.Tickish
import GHC.Utils.Misc ( seqList )
import GHC.Cmm.Dataflow.Block
......
......@@ -34,7 +34,7 @@ import GHC.Data.FastString
import GHC.Types.ForeignCall
import GHC.Utils.Outputable
import GHC.Runtime.Heap.Layout
import GHC.Core (CmmTickish)
import GHC.Types.Tickish (CmmTickish)
import qualified GHC.Types.Unique as U
import GHC.Cmm.Dataflow.Block
......
......@@ -224,8 +224,6 @@ import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Prof
import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame )
import GHC.Core ( GenTickish(SourceNote) )
import GHC.Cmm.Opt
import GHC.Cmm.Graph
import GHC.Cmm
......@@ -250,6 +248,7 @@ import GHC.Types.Literal
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.SrcLoc
import GHC.Types.Tickish ( GenTickish(SourceNote) )
import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Driver.Config
......
......@@ -7,7 +7,7 @@ import GHC.Prelude
import GHC.Cmm.CLabel
import GHC.Cmm.Expr ( GlobalReg(..) )
import GHC.Settings.Config ( cProjectName, cProjectVersion )
import GHC.Core ( CmmTickish, GenTickish(..) )
import GHC.Types.Tickish ( CmmTickish, GenTickish(..) )
import GHC.Cmm.DebugBlock
import GHC.Unit.Module
import GHC.Utils.Outputable
......
......@@ -57,7 +57,7 @@ import GHC.Cmm.Switch
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Core ( GenTickish(..) )
import GHC.Types.Tickish ( GenTickish(..) )
import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
-- The rest:
......
......@@ -72,7 +72,7 @@ import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.CLabel
import GHC.Core ( GenTickish(..) )
import GHC.Types.Tickish ( GenTickish(..) )
import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
-- The rest:
......
......@@ -6,11 +6,6 @@
{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
......@@ -19,8 +14,6 @@
module GHC.Core (
-- * Main data types
Expr(..), Alt(..), Bind(..), AltCon(..), Arg,
GenTickish(..), CoreTickish, StgTickish, CmmTickish, XTickishId,
TickishScoping(..), TickishPlacement(..),
CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
......@@ -59,12 +52,6 @@ module GHC.Core (
isValArg, isTypeArg, isCoArg, isTyCoArg, valArgCount, valBndrCount,
isRuntimeArg, isRuntimeVar,
-- * Tick-related functions
tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,
tickishCanSplit, mkNoCount, mkNoScope,
tickishIsCode, tickishPlace,
tickishContains,
-- * Unfolding data types
Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
......@@ -110,7 +97,6 @@ module GHC.Core (
import GHC.Prelude
import GHC.Platform
import GHC.Types.CostCentre
import GHC.Types.Var.Env( InScopeSet )
import GHC.Types.Var
import GHC.Core.Type
......@@ -119,11 +105,11 @@ import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env( NameEnv, emptyNameEnv )
import GHC.Types.Literal
import GHC.Types.Tickish
import GHC.Core.DataCon
import GHC.Unit.Module
import GHC.Types.Basic
import GHC.Types.Unique.Set
import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
import GHC.Utils.Binary
import GHC.Utils.Misc
......@@ -132,8 +118,6 @@ import GHC.Utils.Panic
import GHC.Driver.Ppr
import Language.Haskell.Syntax.Extension ( NoExtField )
import Data.Data hiding (TyCon)
import Data.Int
import Data.Word
......@@ -941,313 +925,6 @@ type OutArg = CoreArg
type MOutCoercion = MCoercion
{- *********************************************************************
* *
Ticks
* *
************************************************************************
-}
-- | Allows attaching extra information to points in expressions
-- | Used as a data type index for the GenTickish annotations
data TickishPass
= TickishCore
| TickishStg
| TickishCmm
type family XBreakpoint (pass :: TickishPass)
type instance XBreakpoint 'TickishCore = NoExtField
-- | Keep track of the type of breakpoints in STG, for GHCi
type instance XBreakpoint 'TickishStg = Type
type instance XBreakpoint 'TickishCmm = NoExtField
type family XTickishId (pass :: TickishPass)
type instance XTickishId 'TickishCore = Id
type instance XTickishId 'TickishStg = Id
type instance XTickishId 'TickishCmm = NoExtField
type CoreTickish = GenTickish 'TickishCore
type StgTickish = GenTickish 'TickishStg
-- | Tickish in Cmm context (annotations only)
type CmmTickish = GenTickish 'TickishCmm
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in GHC.Core.Lint
data GenTickish pass =
-- | An @{-# SCC #-}@ profiling annotation, either automatically
-- added by the desugarer as a result of -auto-all, or added by
-- the user.
ProfNote {
profNoteCC :: CostCentre, -- ^ the cost centre
profNoteCount :: !Bool, -- ^ bump the entry count?
profNoteScope :: !Bool -- ^ scopes over the enclosed expression
-- (i.e. not just a tick)
}
-- | A "tick" used by HPC to track the execution of each
-- subexpression in the original source code.
| HpcTick {
tickModule :: Module,
tickId :: !Int
}
-- | A breakpoint for the GHCi debugger. This behaves like an HPC
-- tick, but has a list of free variables which will be available
-- for inspection in GHCi when the program stops at the breakpoint.
--
-- NB. we must take account of these Ids when (a) counting free variables,
-- and (b) substituting (don't substitute for them)
| Breakpoint
{ breakpointExt :: XBreakpoint pass
, breakpointId :: !Int
, breakpointFVs :: [XTickishId pass]
-- ^ the order of this list is important:
-- it matches the order of the lists in the
-- appropriate entry in 'GHC.ByteCode.Types.ModBreaks'.
--
-- Careful about substitution! See
-- Note [substTickish] in "GHC.Core.Subst".
}
-- | A source note.
--
-- Source notes are pure annotations: Their presence should neither
-- influence compilation nor execution. The semantics are given by
-- causality: The presence of a source note means that a local
-- change in the referenced source code span will possibly provoke
-- the generated code to change. On the flip-side, the functionality
-- of annotated code *must* be invariant against changes to all
-- source code *except* the spans referenced in the source notes
-- (see "Causality of optimized Haskell" paper for details).
--
-- Therefore extending the scope of any given source note is always
-- valid. Note that it is still undesirable though, as this reduces
-- their usefulness for debugging and profiling. Therefore we will
-- generally try only to make use of this property where it is
-- necessary to enable optimizations.
| SourceNote
{ sourceSpan :: RealSrcSpan -- ^ Source covered
, sourceName :: String -- ^ Name for source location
-- (uses same names as CCs)
}
deriving instance Eq (GenTickish 'TickishCore)
deriving instance Ord (GenTickish 'TickishCore)
deriving instance Data (GenTickish 'TickishCore)
deriving instance Data (GenTickish 'TickishStg)
deriving instance Eq (GenTickish 'TickishCmm)
deriving instance Ord (GenTickish 'TickishCmm)
deriving instance Data (GenTickish 'TickishCmm)
-- | A "counting tick" (where tickishCounts is True) is one that
-- counts evaluations in some way. We cannot discard a counting tick,
-- and the compiler should preserve the number of counting ticks as
-- far as possible.
--
-- However, we still allow the simplifier to increase or decrease
-- sharing, so in practice the actual number of ticks may vary, except
-- that we never change the value from zero to non-zero or vice versa.
tickishCounts :: GenTickish pass -> Bool
tickishCounts n@ProfNote{} = profNoteCount n
tickishCounts HpcTick{} = True
tickishCounts Breakpoint{} = True
tickishCounts _ = False
-- | Specifies the scoping behaviour of ticks. This governs the
-- behaviour of ticks that care about the covered code and the cost
-- associated with it. Important for ticks relating to profiling.
data TickishScoping =
-- | No scoping: The tick does not care about what code it
-- covers. Transformations can freely move code inside as well as
-- outside without any additional annotation obligations
NoScope
-- | Soft scoping: We want all code that is covered to stay
-- covered. Note that this scope type does not forbid
-- transformations from happening, as long as all results of
-- the transformations are still covered by this tick or a copy of
-- it. For example
--
-- let x = tick<...> (let y = foo in bar) in baz
-- ===>
-- let x = tick<...> bar; y = tick<...> foo in baz
--
-- Is a valid transformation as far as "bar" and "foo" is
-- concerned, because both still are scoped over by the tick.
--
-- Note though that one might object to the "let" not being
-- covered by the tick any more. However, we are generally lax
-- with this - constant costs don't matter too much, and given
-- that the "let" was effectively merged we can view it as having
-- lost its identity anyway.
--
-- Also note that this scoping behaviour allows floating a tick
-- "upwards" in pretty much any situation. For example:
--
-- case foo of x -> tick<...> bar
-- ==>
-- tick<...> case foo of x -> bar
--
-- While this is always legal, we want to make a best effort to
-- only make us of this where it exposes transformation
-- opportunities.
| SoftScope
-- | Cost centre scoping: We don't want any costs to move to other
-- cost-centre stacks. This means we not only want no code or cost
-- to get moved out of their cost centres, but we also object to
-- code getting associated with new cost-centre ticks - or
-- changing the order in which they get applied.
--
-- A rule of thumb is that we don't want any code to gain new
-- annotations. However, there are notable exceptions, for
-- example:
--
-- let f = \y -> foo in tick<...> ... (f x) ...
-- ==>
-- tick<...> ... foo[x/y] ...
--
-- In-lining lambdas like this is always legal, because inlining a
-- function does not change the cost-centre stack when the
-- function is called.
| CostCentreScope
deriving (Eq)
-- | Returns the intended scoping rule for a Tickish
tickishScoped :: GenTickish pass -> TickishScoping
tickishScoped n@ProfNote{}
| profNoteScope n = CostCentreScope
| otherwise = NoScope
tickishScoped HpcTick{} = NoScope
tickishScoped Breakpoint{} = CostCentreScope
-- Breakpoints are scoped: eventually we're going to do call
-- stacks, but also this helps prevent the simplifier from moving
-- breakpoints around and changing their result type (see #1531).
tickishScoped SourceNote{} = SoftScope
-- | Returns whether the tick scoping rule is at least as permissive
-- as the given scoping rule.
tickishScopesLike :: GenTickish pass -> TickishScoping -> Bool
tickishScopesLike t scope = tickishScoped t `like` scope
where NoScope `like` _ = True
_ `like` NoScope = False
SoftScope `like` _ = True
_ `like` SoftScope = False
CostCentreScope `like` _ = True
-- | Returns @True@ for ticks that can be floated upwards easily even
-- where it might change execution counts, such as:
--
-- Just (tick<...> foo)
-- ==>
-- tick<...> (Just foo)
--
-- This is a combination of @tickishSoftScope@ and
-- @tickishCounts@. Note that in principle splittable ticks can become
-- floatable using @mkNoTick@ -- even though there's currently no
-- tickish for which that is the case.
tickishFloatable :: GenTickish pass -> Bool
tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
-- | Returns @True@ for a tick that is both counting /and/ scoping and
-- can be split into its (tick, scope) parts using 'mkNoScope' and
-- 'mkNoTick' respectively.
tickishCanSplit :: GenTickish pass -> Bool
tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}
= True
tickishCanSplit _ = False
mkNoCount :: GenTickish pass -> GenTickish pass
mkNoCount n | not (tickishCounts n) = n
| not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"
mkNoCount n@ProfNote{} = n {profNoteCount = False}
mkNoCount _ = panic "mkNoCount: Undefined split!"
mkNoScope :: GenTickish pass -> GenTickish pass
mkNoScope n | tickishScoped n == NoScope = n
| not (tickishCanSplit n) = panic "mkNoScope: Cannot split!"
mkNoScope n@ProfNote{} = n {profNoteScope = False}
mkNoScope _ = panic "mkNoScope: Undefined split!"
-- | Return @True@ if this source annotation compiles to some backend
-- code. Without this flag, the tickish is seen as a simple annotation
-- that does not have any associated evaluation code.
--
-- What this means that we are allowed to disregard the tick if doing
-- so means that we can skip generating any code in the first place. A
-- typical example is top-level bindings:
--
-- foo = tick<...> \y -> ...
-- ==>
-- foo = \y -> tick<...> ...
--
-- Here there is just no operational difference between the first and
-- the second version. Therefore code generation should simply
-- translate the code as if it found the latter.
tickishIsCode :: GenTickish pass -> Bool
tickishIsCode SourceNote{} = False
tickishIsCode _tickish = True -- all the rest for now
-- | Governs the kind of expression that the tick gets placed on when
-- annotating for example using @mkTick@. If we find that we want to
-- put a tickish on an expression ruled out here, we try to float it
-- inwards until we find a suitable expression.
data TickishPlacement =
-- | Place ticks exactly on run-time expressions. We can still
-- move the tick through pure compile-time constructs such as
-- other ticks, casts or type lambdas. This is the most
-- restrictive placement rule for ticks, as all tickishs have in
-- common that they want to track runtime processes. The only
-- legal placement rule for counting ticks.
PlaceRuntime
-- | As @PlaceRuntime@, but we float the tick through all
-- lambdas. This makes sense where there is little difference
-- between annotating the lambda and annotating the lambda's code.
| PlaceNonLam
-- | In addition to floating through lambdas, cost-centre style
-- tickishs can also be moved from constructors, non-function
-- variables and literals. For example:
--
-- let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
--
-- Neither the constructor application, the variable or the
-- literal are likely to have any cost worth mentioning. And even
-- if y names a thunk, the call would not care about the
-- evaluation context. Therefore removing all annotations in the
-- above example is safe.
| PlaceCostCentre
deriving (Eq)
-- | Placement behaviour we want for the ticks
tickishPlace :: GenTickish pass -> TickishPlacement
tickishPlace n@ProfNote{}
| profNoteCount n = PlaceRuntime
| otherwise = PlaceCostCentre
tickishPlace HpcTick{} = PlaceRuntime
tickishPlace Breakpoint{} = PlaceRuntime
tickishPlace SourceNote{} = PlaceNonLam
-- | Returns whether one tick "contains" the other one, therefore
-- making the second tick redundant.
tickishContains :: Eq (GenTickish pass)
=> GenTickish pass -> GenTickish pass -> Bool
tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)
= containsSpan sp1 sp2 && n1 == n2
-- compare the String last
tickishContains t1 t2
= t1 == t2
{-
************************************************************************
* *
......
......@@ -65,6 +65,7 @@ import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Name.Set
import GHC.Types.Name
import GHC.Types.Tickish
import GHC.Types.Var.Set
import GHC.Types.Var
import GHC.Core.Type
......
......@@ -53,6 +53,7 @@ import GHC.Types.Id.Info
import GHC.Core.Ppr
import GHC.Core.Coercion
import GHC.Types.SrcLoc
import GHC.Types.Tickish
import GHC.Core.Type as Type
import GHC.Core.Multiplicity
import GHC.Core.UsageEnv
......
......@@ -32,6 +32,7 @@ import GHC.Data.TrieMap
import GHC.Core.Map.Type
import GHC.Core
import GHC.Core.Type
import GHC.Types.Tickish
import GHC.Types.Var
import GHC.Utils.Misc
......
......@@ -58,6 +58,7 @@ import GHC.Core.Predicate ( isDictTy )
import GHC.Core.Multiplicity
import GHC.Types.Var.Set
import GHC.Types.Basic
import GHC.Types.Tickish
import GHC.Builtin.Uniques
import GHC.Driver.Session ( DynFlags, GeneralFlag(..), gopt )
import GHC.Utils.Outputable
......
......@@ -30,6 +30,7 @@ import GHC.Core.Type ( tyConAppArgs )
import GHC.Core
import GHC.Utils.Outputable
import GHC.Types.Basic
import GHC.Types.Tickish
import GHC.Core.Map.Expr
import GHC.Utils.Misc ( filterOut, equalLength, debugIsOn )
import GHC.Utils.Panic
......
......@@ -31,6 +31,7 @@ import GHC.Driver.Ppr
import GHC.Types.CostCentre
import GHC.Types.CostCentre.State
import GHC.Types.Name hiding (varName)
import GHC.Types.Tickish
import GHC.Unit.Module.Name
import GHC.Unit.Module.ModGuts
import GHC.Types.SrcLoc
......
......@@ -60,6 +60,7 @@ import GHC.Core.Type
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Name.Occurrence ( occNameFS )
import GHC.Types.Tickish
import GHC.Builtin.Names
import GHC.Data.Maybe ( orElse )
import GHC.Types.Name ( Name, nameOccName )
......
......@@ -34,6 +34,7 @@ import GHC.Core.Type
import GHC.Types.Basic ( RecFlag(..), isRec )
import GHC.Types.Id ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
import GHC.Types.Tickish
import GHC.Types.Var
import GHC.Types.Var.Set
......
......@@ -22,6 +22,7 @@ import GHC.Driver.Session
import GHC.Utils.Logger ( dumpIfSet_dyn, DumpFormat (..), Logger )
import GHC.Types.Id ( Id, idArity, idType, isDeadEndId,
isJoinId, isJoinId_maybe )
import GHC.Types.Tickish
import GHC.Core.Opt.SetLevels
import GHC.Types.Unique.Supply ( UniqSupply )
import GHC.Data.Bag
......
......@@ -33,6 +33,7 @@ import GHC.Core.Opt.Arity ( joinRhsArity )
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Basic
import GHC.Types.Tickish
import GHC.Unit.Module( Module )
import GHC.Core.Coercion
import GHC.Core.Type
......
......@@ -70,6 +70,7 @@ import GHC.Types.Basic
import GHC.Types.Demand ( zapDmdEnvSig )
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Tickish
import GHC.Types.Unique.Supply ( UniqSupply )
import GHC.Types.Unique.FM
import GHC.Types.Name.Ppr
......
......@@ -108,6 +108,7 @@ import GHC.Types.Cpr ( mkCprSig, botCpr )
import GHC.Types.Name ( getOccName, mkSystemVarName )
import GHC.Types.Name.Occurrence ( occNameString )
import GHC.Types.Unique ( hasKey )
import GHC.Types.Tickish ( tickishIsCode )
import GHC.Core.Type ( Type, splitTyConApp_maybe, tyCoVarsOfType
, mightBeUnliftedType, closeOverKindsDSet )
import GHC.Core.Multiplicity ( pattern Many )
......
......@@ -59,6 +59,7 @@ import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts )
import GHC.Types.Basic
import GHC.Utils.Monad ( mapAccumLM, liftIO )
import GHC.Utils.Logger
import GHC.Types.Tickish
import GHC.Types.Var ( isTyCoVar )
import GHC.Data.Maybe ( orElse )
import Control.Monad
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment