summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLuite Stegeman <stegeman@gmail.com>2020-12-10 14:19:02 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-20 07:49:15 -0400
commitdd11f2d5e87ba83ca16510e3e1ac6c41c1df1647 (patch)
tree66550e7e66b679ae9ec31cab237d7bbced67b2ee
parentceef490b25dbff93860b121c58b0191b1a0c07bf (diff)
downloadhaskell-dd11f2d5e87ba83ca16510e3e1ac6c41c1df1647.tar.gz
Save the type of breakpoints in the Breakpoint tick in STG
GHCi needs to know the types of all breakpoints, but it's not possible to get the exprType of any expression in STG. This is preparation for the upcoming change to make GHCi bytecode from STG instead of Core.
-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