summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Cmm/Parser.y2
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf.hs2
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs2
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs2
-rw-r--r--compiler/GHC/Core.hs44
-rw-r--r--compiler/GHC/Core/FVs.hs6
-rw-r--r--compiler/GHC/Core/Lint.hs8
-rw-r--r--compiler/GHC/Core/Opt/OccurAnal.hs2
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs4
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs4
-rw-r--r--compiler/GHC/Core/Ppr.hs7
-rw-r--r--compiler/GHC/Core/Subst.hs4
-rw-r--r--compiler/GHC/Core/Tidy.hs3
-rw-r--r--compiler/GHC/Core/Utils.hs2
-rw-r--r--compiler/GHC/CoreToByteCode.hs4
-rw-r--r--compiler/GHC/CoreToStg.hs30
-rw-r--r--compiler/GHC/CoreToStg/Prep.hs4
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs2
-rw-r--r--compiler/GHC/Iface/Tidy.hs2
-rw-r--r--compiler/GHC/Stg/FVs.hs6
-rw-r--r--compiler/GHC/Stg/Syntax.hs8
-rw-r--r--compiler/GHC/StgToCmm/Expr.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs2
23 files changed, 97 insertions, 55 deletions
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 92e981a841..ceb5ba8bad 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -224,7 +224,7 @@ import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Prof
import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame )
-import GHC.Core ( Tickish(SourceNote) )
+import GHC.Core ( GenTickish(SourceNote) )
import GHC.Cmm.Opt
import GHC.Cmm.Graph
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index 7e03549b24..ab728dcb92 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -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 ( Tickish(..) )
+import GHC.Core ( Tickish, GenTickish(..) )
import GHC.Cmm.DebugBlock
import GHC.Unit.Module
import GHC.Utils.Outputable
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 01a3a67333..d547412935 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -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 ( Tickish(..) )
+import GHC.Core ( GenTickish(..) )
import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
-- The rest:
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 60d19f43c1..7699b0c692 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -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 ( Tickish(..) )
+import GHC.Core ( GenTickish(..) )
import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
-- The rest:
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 168e33e189..fee181ac70 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -6,6 +6,12 @@
{-# 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 #-}
@@ -13,7 +19,8 @@
module GHC.Core (
-- * Main data types
Expr(..), Alt(..), Bind(..), AltCon(..), Arg,
- Tickish(..), TickishScoping(..), TickishPlacement(..),
+ GenTickish(..), Tickish, StgTickish,
+ TickishScoping(..), TickishPlacement(..),
CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
@@ -117,6 +124,7 @@ import GHC.Unit.Module
import GHC.Types.Basic
import GHC.Types.Unique.Set
import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
+import GHC.Hs.Extension ( NoExtField )
import GHC.Utils.Binary
import GHC.Utils.Misc
@@ -941,9 +949,22 @@ type MOutCoercion = MCoercion
-- | Allows attaching extra information to points in expressions
+-- | Used as a data type index for the GenTickish annotations
+data TickishPass
+ = TickishCore
+ | TickishStg
+
+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 Tickish = GenTickish 'TickishCore
+type StgTickish = GenTickish 'TickishStg
+
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in GHC.Core.Lint
-data Tickish id =
+data GenTickish pass id =
-- | An @{-# SCC #-}@ profiling annotation, either automatically
-- added by the desugarer as a result of -auto-all, or added by
-- the user.
@@ -968,7 +989,8 @@ data Tickish id =
-- NB. we must take account of these Ids when (a) counting free variables,
-- and (b) substituting (don't substitute for them)
| Breakpoint
- { breakpointId :: !Int
+ { breakpointExt :: XBreakpoint pass
+ , breakpointId :: !Int
, breakpointFVs :: [id] -- ^ the order of this list is important:
-- it matches the order of the lists in the
-- appropriate entry in 'GHC.ByteCode.Types.ModBreaks'.
@@ -999,7 +1021,11 @@ data Tickish id =
-- (uses same names as CCs)
}
- deriving (Eq, Ord, Data)
+deriving instance Eq a => Eq (GenTickish 'TickishCore a)
+deriving instance Ord a => Ord (GenTickish 'TickishCore a)
+deriving instance Data a => Data (GenTickish 'TickishCore a)
+
+deriving instance Data a => Data (GenTickish 'TickishStg a)
-- | A "counting tick" (where tickishCounts is True) is one that
-- counts evaluations in some way. We cannot discard a counting tick,
@@ -1009,7 +1035,7 @@ data Tickish id =
-- 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 :: Tickish id -> Bool
+tickishCounts :: GenTickish pass id -> Bool
tickishCounts n@ProfNote{} = profNoteCount n
tickishCounts HpcTick{} = True
tickishCounts Breakpoint{} = True
@@ -1078,7 +1104,7 @@ data TickishScoping =
deriving (Eq)
-- | Returns the intended scoping rule for a Tickish
-tickishScoped :: Tickish id -> TickishScoping
+tickishScoped :: GenTickish pass id -> TickishScoping
tickishScoped n@ProfNote{}
| profNoteScope n = CostCentreScope
| otherwise = NoScope
@@ -1091,7 +1117,7 @@ tickishScoped SourceNote{} = SoftScope
-- | Returns whether the tick scoping rule is at least as permissive
-- as the given scoping rule.
-tickishScopesLike :: Tickish id -> TickishScoping -> Bool
+tickishScopesLike :: GenTickish pass id -> TickishScoping -> Bool
tickishScopesLike t scope = tickishScoped t `like` scope
where NoScope `like` _ = True
_ `like` NoScope = False
@@ -1110,7 +1136,7 @@ tickishScopesLike t scope = tickishScoped t `like` scope
-- @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 :: Tickish id -> Bool
+tickishFloatable :: GenTickish pass id -> Bool
tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
-- | Returns @True@ for a tick that is both counting /and/ scoping and
@@ -1148,7 +1174,7 @@ mkNoScope _ = panic "mkNoScope: Undefined split!"
-- 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 :: Tickish id -> Bool
+tickishIsCode :: GenTickish pass id -> Bool
tickishIsCode SourceNote{} = False
tickishIsCode _tickish = True -- all the rest for now
diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs
index bf5dab7bc3..da661f1439 100644
--- a/compiler/GHC/Core/FVs.hs
+++ b/compiler/GHC/Core/FVs.hs
@@ -290,7 +290,7 @@ exprs_fvs :: [CoreExpr] -> FV
exprs_fvs exprs = mapUnionFV expr_fvs exprs
tickish_fvs :: Tickish Id -> FV
-tickish_fvs (Breakpoint _ ids) = FV.mkFVs ids
+tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids
tickish_fvs _ = emptyFV
{-
@@ -779,8 +779,8 @@ freeVars = go
, AnnTick tickish expr2 )
where
expr2 = go expr
- tickishFVs (Breakpoint _ ids) = mkDVarSet ids
- tickishFVs _ = emptyDVarSet
+ tickishFVs (Breakpoint _ _ ids) = mkDVarSet ids
+ tickishFVs _ = emptyDVarSet
go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty)
go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co)
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 89914e967f..f3c69defef 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -857,10 +857,10 @@ lintCoreExpr (Cast expr co)
lintCoreExpr (Tick tickish expr)
= do case tickish of
- Breakpoint _ ids -> forM_ ids $ \id -> do
- checkDeadIdOcc id
- lookupIdInScope id
- _ -> return ()
+ Breakpoint _ _ ids -> forM_ ids $ \id -> do
+ checkDeadIdOcc id
+ lookupIdInScope id
+ _ -> return ()
markAllJoinsBadIf block_joins $ lintCoreExpr expr
where
block_joins = not (tickish `tickishScopesLike` SoftScope)
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index 3f31ae258b..74fe628a49 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -1929,7 +1929,7 @@ occAnal env (Tick tickish body)
| tickish `tickishScopesLike` SoftScope
= (markAllNonTail usage, Tick tickish body')
- | Breakpoint _ ids <- tickish
+ | Breakpoint _ _ ids <- tickish
= (usage_lam `andUDs` foldr addManyOcc emptyDetails ids, Tick tickish body')
-- never substitute for any of the Ids in a Breakpoint
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 13f0fdc46c..f137534ec0 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -1254,8 +1254,8 @@ simplTick env tickish expr cont
simplTickish env tickish
- | Breakpoint n ids <- tickish
- = Breakpoint n (map (getDoneId . substId env) ids)
+ | Breakpoint ext n ids <- tickish
+ = Breakpoint ext n (map (getDoneId . substId env) ids)
| otherwise = tickish
-- Push type application and coercion inside a tick
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index c2510b97c0..63e52ce258 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -1126,8 +1126,8 @@ specLam env bndrs body
--------------
specTickish :: SpecEnv -> Tickish Id -> Tickish Id
-specTickish env (Breakpoint ix ids)
- = Breakpoint ix [ id' | id <- ids, Var id' <- [specVar env id]]
+specTickish env (Breakpoint ext ix ids)
+ = Breakpoint ext ix [ id' | id <- ids, Var id' <- [specVar env id]]
-- drop vars from the list if they have a non-variable substitution.
-- should never happen, but it's harmless to drop them anyway.
specTickish _ other_tickish = other_tickish
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index ddfa2ea2a6..820f1f1785 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-
@@ -645,13 +648,13 @@ pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
-----------------------------------------------------
-}
-instance Outputable id => Outputable (Tickish id) where
+instance Outputable id => Outputable (GenTickish pass id) where
ppr (HpcTick modl ix) =
hcat [text "hpc<",
ppr modl, comma,
ppr ix,
text ">"]
- ppr (Breakpoint ix vars) =
+ ppr (Breakpoint _ext ix vars) =
hcat [text "break<",
ppr ix,
text ">",
diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 918733a725..7110208d79 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -718,8 +718,8 @@ substDVarSet subst fvs
------------------
substTickish :: Subst -> Tickish Id -> Tickish Id
-substTickish subst (Breakpoint n ids)
- = Breakpoint n (map do_one ids)
+substTickish subst (Breakpoint ext n ids)
+ = Breakpoint ext n (map do_one ids)
where
do_one = getIdFromTrivialExpr . lookupIdSubst subst
substTickish _subst other = other
diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index a1b66ec3f8..3e71d2c5b2 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/compiler/GHC/Core/Tidy.hs
@@ -89,7 +89,8 @@ tidyAlt env (Alt con vs rhs)
------------ Tickish --------------
tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
-tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)
+tidyTickish env (Breakpoint ext ix ids)
+ = Breakpoint ext ix (map (tidyVarOcc env) ids)
tidyTickish _ other_tickish = other_tickish
------------ Rules --------------
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index b87ab11453..f2772edd8b 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -2168,7 +2168,7 @@ eqExpr in_scope e1 e2
= c1 == c2 && go (rnBndrs2 env bs1 bs2) e1 e2
eqTickish :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool
-eqTickish env (Breakpoint lid lids) (Breakpoint rid rids)
+eqTickish env (Breakpoint _ lid lids) (Breakpoint _ rid rids)
= lid == rid && map (rnOccL env) lids == map (rnOccR env) rids
eqTickish _ l r = l == r
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index b1ebac9231..23bb018806 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -418,7 +418,7 @@ schemeR_wrk fvs nm original_body (args, body)
-- introduce break instructions for ticked expressions
schemeER_wrk :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList
schemeER_wrk d p rhs
- | AnnTick (Breakpoint tick_no fvs) (_annot, newRhs) <- rhs
+ | AnnTick (Breakpoint _ext tick_no fvs) (_annot, newRhs) <- rhs
= do code <- schemeE d 0 p newRhs
cc_arr <- getCCArray
this_mod <- moduleName <$> getCurrentModule
@@ -616,7 +616,7 @@ schemeE d s p (AnnLet binds (_,body)) = do
-- call exprFreeVars on a deAnnotated expression, this may not be the
-- best way to calculate the free vars but it seemed like the least
-- intrusive thing to do
-schemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs)
+schemeE d s p exp@(AnnTick (Breakpoint _ext _id _fvs) _rhs)
| isLiftedTypeKind (typeKind ty)
= do id <- newId ty
-- Todo: is emptyVarSet correct on the next line?
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index bfe9a6c89b..7b930b9c01 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -413,13 +413,14 @@ coreToStgExpr expr@(Lam _ _)
text "Unexpected value lambda:" $$ ppr expr
coreToStgExpr (Tick tick expr)
- = do case tick of
- HpcTick{} -> return ()
- ProfNote{} -> return ()
- SourceNote{} -> return ()
- Breakpoint{} -> panic "coreToStgExpr: breakpoint should not happen"
+ = do stg_tick <- case tick of
+ HpcTick m i -> return (HpcTick m i)
+ ProfNote cc cnt sc -> return (ProfNote cc cnt sc)
+ SourceNote span nm -> return (SourceNote span nm)
+ Breakpoint{} ->
+ panic "coreToStgExpr: breakpoint should not happen"
expr2 <- coreToStgExpr expr
- return (StgTick tick expr2)
+ return (StgTick stg_tick expr2)
coreToStgExpr (Cast expr _)
= coreToStgExpr expr
@@ -568,7 +569,12 @@ coreToStgApp f args ticks = do
TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args')
_other -> StgApp f args'
- tapp = foldr StgTick app (ticks ++ ticks')
+ convert_tick (Breakpoint _ bid fvs) = res_ty `seq` Breakpoint res_ty bid fvs
+ convert_tick (HpcTick m i) = HpcTick m i
+ convert_tick (SourceNote span nm) = SourceNote span nm
+ convert_tick (ProfNote cc cnt scope) = ProfNote cc cnt scope
+ add_tick !t !e = StgTick t e
+ tapp = foldr add_tick app (map convert_tick ticks ++ ticks')
-- Forcing these fixes a leak in the code generator, noticed while
-- profiling for trac #4367
@@ -579,7 +585,7 @@ coreToStgApp f args ticks = do
-- This is the guy that turns applications into A-normal form
-- ---------------------------------------------------------------------------
-coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [Tickish Id])
+coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish Id])
coreToStgArgs []
= return ([], [])
@@ -594,7 +600,13 @@ coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion token
coreToStgArgs (Tick t e : args)
= ASSERT( not (tickishIsCode t) )
do { (args', ts) <- coreToStgArgs (e : args)
- ; return (args', t:ts) }
+ ; let convert_tick (Breakpoint _ bid fvs) =
+ let !ty = exprType e in Breakpoint ty bid fvs
+ convert_tick (HpcTick m i) = HpcTick m i
+ convert_tick (SourceNote span nm) = SourceNote span nm
+ convert_tick (ProfNote cc cnt scope) = ProfNote cc cnt scope
+ !t' = convert_tick t
+ ; return (args', t':ts) }
coreToStgArgs (arg : args) = do -- Non-type argument
(stg_args, ticks) <- coreToStgArgs args
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index 5395a737d6..21c1fb0272 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -610,9 +610,9 @@ cpeRhsE env (Tick tickish expr)
= do { body <- cpeBodyNF env expr
; return (emptyFloats, mkTick tickish' body) }
where
- tickish' | Breakpoint n fvs <- tickish
+ tickish' | Breakpoint ext n fvs <- tickish
-- See also 'substTickish'
- = Breakpoint n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs)
+ = Breakpoint ext n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs)
| otherwise
= tickish
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index dca2b09f7d..726b69a69a 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -1239,7 +1239,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
count = countEntries && gopt Opt_ProfCountEntries dflags
return $ ProfNote cc count True{-scopes-}
- Breakpoints -> Breakpoint <$> addMixEntry me <*> pure ids
+ Breakpoints -> Breakpoint noExtField <$> addMixEntry me <*> pure ids
SourceNotes | RealSrcSpan pos' _ <- pos ->
return $ SourceNote pos' cc_name
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 14afbeeb14..f4e681420c 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -817,7 +817,7 @@ dffvExpr :: CoreExpr -> DFFV ()
dffvExpr (Var v) = insert v
dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2
dffvExpr (Lam v e) = extendScope v (dffvExpr e)
-dffvExpr (Tick (Breakpoint _ ids) e) = mapM_ insert ids >> dffvExpr e
+dffvExpr (Tick (Breakpoint _ _ ids) e) = mapM_ insert ids >> dffvExpr e
dffvExpr (Tick _other e) = dffvExpr e
dffvExpr (Cast e _) = dffvExpr e
dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e)
diff --git a/compiler/GHC/Stg/FVs.hs b/compiler/GHC/Stg/FVs.hs
index ce40307420..3385f2e275 100644
--- a/compiler/GHC/Stg/FVs.hs
+++ b/compiler/GHC/Stg/FVs.hs
@@ -47,7 +47,7 @@ import GHC.Prelude
import GHC.Stg.Syntax
import GHC.Types.Id
import GHC.Types.Var.Set
-import GHC.Core ( Tickish(Breakpoint) )
+import GHC.Core ( GenTickish(Breakpoint) )
import GHC.Utils.Misc
import Data.Maybe ( mapMaybe )
@@ -139,8 +139,8 @@ expr env = go
where
(e', fvs) = go e
fvs' = unionDVarSet (tickish tick) fvs
- tickish (Breakpoint _ ids) = mkDVarSet ids
- tickish _ = emptyDVarSet
+ tickish (Breakpoint _ _ ids) = mkDVarSet ids
+ tickish _ = emptyDVarSet
go_bind dc bind body = (dc bind' body', fvs)
where
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 53e4b07c69..0f2dd258e2 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -68,7 +68,7 @@ module GHC.Stg.Syntax (
import GHC.Prelude
-import GHC.Core ( AltCon, Tickish )
+import GHC.Core ( AltCon, StgTickish )
import GHC.Types.CostCentre ( CostCentreStack )
import Data.ByteString ( ByteString )
import Data.Data ( Data )
@@ -175,13 +175,13 @@ stgArgType (StgLitArg lit) = literalType lit
-- | Strip ticks of a given type from an STG expression.
-stripStgTicksTop :: (Tickish Id -> Bool) -> GenStgExpr p -> ([Tickish Id], GenStgExpr p)
+stripStgTicksTop :: (StgTickish Id -> Bool) -> GenStgExpr p -> ([StgTickish Id], GenStgExpr p)
stripStgTicksTop p = go []
where go ts (StgTick t e) | p t = go (t:ts) e
go ts other = (reverse ts, other)
-- | Strip ticks of a given type from an STG expression returning only the expression.
-stripStgTicksTopE :: (Tickish Id -> Bool) -> GenStgExpr p -> GenStgExpr p
+stripStgTicksTopE :: (StgTickish Id -> Bool) -> GenStgExpr p -> GenStgExpr p
stripStgTicksTopE p = go
where go (StgTick t e) | p t = go e
go other = other
@@ -368,7 +368,7 @@ Finally for @hpc@ expressions we introduce a new STG construct.
-}
| StgTick
- (Tickish Id)
+ (StgTickish Id)
(GenStgExpr pass) -- sub expression
-- END of GenStgExpr
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index 0e0990b901..91853b5799 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -1113,7 +1113,7 @@ emitEnter fun = do
-- | Generate Cmm code for a tick. Depending on the type of Tickish,
-- this will either generate actual Cmm instrumentation code, or
-- simply pass on the annotation as a @CmmTickish@.
-cgTick :: Tickish Id -> FCode ()
+cgTick :: StgTickish Id -> FCode ()
cgTick tick
= do { platform <- getPlatform
; case tick of
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index e19491e93a..bc98bd279f 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -28,7 +28,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Match ( tcGRHSsPat, tcMatchesFun )
import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckMonoExpr )
import {-# SOURCE #-} GHC.Tc.TyCl.PatSyn ( tcPatSynDecl, tcPatSynBuilderBind )
-import GHC.Core (Tickish (..))
+import GHC.Core (Tickish, GenTickish (..))
import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC))
import GHC.Driver.Session
import GHC.Data.FastString
View Lorry Controller Status