summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLuite Stegeman <stegeman@gmail.com>2020-12-10 16:32:19 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-20 07:49:15 -0400
commit26328a688183e3af49b5ac315b27afc2691bbc46 (patch)
tree007b8105d2cabf52142cb8f5d7b790e888e42197
parentdd11f2d5e87ba83ca16510e3e1ac6c41c1df1647 (diff)
downloadhaskell-26328a688183e3af49b5ac315b27afc2691bbc46.tar.gz
remove superfluous 'id' type parameter from GenTickish
The 'id' type is now determined by the pass, using the XTickishId type family.
-rw-r--r--compiler/GHC/Cmm/Node.hs5
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf.hs4
-rw-r--r--compiler/GHC/Core.hs62
-rw-r--r--compiler/GHC/Core/FVs.hs3
-rw-r--r--compiler/GHC/Core/Map/Expr.hs6
-rw-r--r--compiler/GHC/Core/Opt/CallerCC.hs2
-rw-r--r--compiler/GHC/Core/Opt/FloatOut.hs2
-rw-r--r--compiler/GHC/Core/Opt/OccurAnal.hs2
-rw-r--r--compiler/GHC/Core/Opt/Pipeline.hs2
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs3
-rw-r--r--compiler/GHC/Core/Opt/Simplify/Utils.hs2
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs2
-rw-r--r--compiler/GHC/Core/Ppr.hs4
-rw-r--r--compiler/GHC/Core/Seq.hs4
-rw-r--r--compiler/GHC/Core/SimpleOpt.hs2
-rw-r--r--compiler/GHC/Core/Stats.hs2
-rw-r--r--compiler/GHC/Core/Subst.hs2
-rw-r--r--compiler/GHC/Core/Tidy.hs2
-rw-r--r--compiler/GHC/Core/Utils.hs24
-rw-r--r--compiler/GHC/CoreToIface.hs2
-rw-r--r--compiler/GHC/CoreToStg.hs6
-rw-r--r--compiler/GHC/CoreToStg/Prep.hs4
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs6
-rw-r--r--compiler/GHC/HsToCore/Utils.hs4
-rw-r--r--compiler/GHC/IfaceToCore.hs2
-rw-r--r--compiler/GHC/Stg/Debug.hs6
-rw-r--r--compiler/GHC/Stg/FVs.hs2
-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
30 files changed, 99 insertions, 80 deletions
diff --git a/compiler/GHC/Cmm/Node.hs b/compiler/GHC/Cmm/Node.hs
index 943efaa3fd..37a27fd75f 100644
--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
@@ -34,7 +34,7 @@ import GHC.Data.FastString
import GHC.Types.ForeignCall
import GHC.Utils.Outputable
import GHC.Runtime.Heap.Layout
-import GHC.Core (Tickish)
+import GHC.Core (CmmTickish)
import qualified GHC.Types.Unique as U
import GHC.Cmm.Dataflow.Block
@@ -597,9 +597,6 @@ mapCollectSuccessors _ n = (n, [])
-- -----------------------------------------------------------------------------
--- | Tickish in Cmm context (annotations only)
-type CmmTickish = Tickish ()
-
-- | Tick scope identifier, allowing us to reason about what
-- annotations in a Cmm block should scope over. We especially take
-- care to allow optimisations to reorganise blocks without losing
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index ab728dcb92..b79397a998 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, GenTickish(..) )
+import GHC.Core ( CmmTickish, GenTickish(..) )
import GHC.Cmm.DebugBlock
import GHC.Unit.Module
import GHC.Utils.Outputable
@@ -210,7 +210,7 @@ blockToDwarf config blk
| Just _ <- dblPosition blk = Just $ mkAsmTempLabel $ dblLabel blk
| otherwise = Nothing -- block was optimized out
-tickToDwarf :: Tickish () -> [DwarfInfo]
+tickToDwarf :: CmmTickish -> [DwarfInfo]
tickToDwarf (SourceNote ss _) = [DwarfSrcNote ss]
tickToDwarf _ = []
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index fee181ac70..2b9da7a1dd 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -19,7 +19,7 @@
module GHC.Core (
-- * Main data types
Expr(..), Alt(..), Bind(..), AltCon(..), Arg,
- GenTickish(..), Tickish, StgTickish,
+ GenTickish(..), Tickish, StgTickish, CmmTickish, XTickishId,
TickishScoping(..), TickishPlacement(..),
CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
@@ -275,7 +275,7 @@ data Expr b
| Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants]
-- and Note [Why does Case have a 'Type' field?]
| Cast (Expr b) Coercion
- | Tick (Tickish Id) (Expr b)
+ | Tick Tickish (Expr b)
| Type Type
| Coercion Coercion
deriving Data
@@ -953,18 +953,27 @@ type MOutCoercion = MCoercion
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 Tickish = 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 id =
+data GenTickish pass =
-- | An @{-# SCC #-}@ profiling annotation, either automatically
-- added by the desugarer as a result of -auto-all, or added by
-- the user.
@@ -991,7 +1000,8 @@ data GenTickish pass id =
| Breakpoint
{ breakpointExt :: XBreakpoint pass
, breakpointId :: !Int
- , breakpointFVs :: [id] -- ^ the order of this list is important:
+ , 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'.
--
@@ -1021,11 +1031,16 @@ data GenTickish pass id =
-- (uses same names as CCs)
}
-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 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)
-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,
@@ -1035,7 +1050,7 @@ deriving instance Data a => Data (GenTickish 'TickishStg a)
-- 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 id -> Bool
+tickishCounts :: GenTickish pass -> Bool
tickishCounts n@ProfNote{} = profNoteCount n
tickishCounts HpcTick{} = True
tickishCounts Breakpoint{} = True
@@ -1104,7 +1119,7 @@ data TickishScoping =
deriving (Eq)
-- | Returns the intended scoping rule for a Tickish
-tickishScoped :: GenTickish pass id -> TickishScoping
+tickishScoped :: GenTickish pass -> TickishScoping
tickishScoped n@ProfNote{}
| profNoteScope n = CostCentreScope
| otherwise = NoScope
@@ -1117,7 +1132,7 @@ tickishScoped SourceNote{} = SoftScope
-- | Returns whether the tick scoping rule is at least as permissive
-- as the given scoping rule.
-tickishScopesLike :: GenTickish pass id -> TickishScoping -> Bool
+tickishScopesLike :: GenTickish pass -> TickishScoping -> Bool
tickishScopesLike t scope = tickishScoped t `like` scope
where NoScope `like` _ = True
_ `like` NoScope = False
@@ -1136,24 +1151,24 @@ 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 :: GenTickish pass id -> Bool
+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 :: Tickish id -> Bool
+tickishCanSplit :: GenTickish pass -> Bool
tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}
= True
tickishCanSplit _ = False
-mkNoCount :: Tickish id -> Tickish id
+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 :: Tickish id -> Tickish id
+mkNoScope :: GenTickish pass -> GenTickish pass
mkNoScope n | tickishScoped n == NoScope = n
| not (tickishCanSplit n) = panic "mkNoScope: Cannot split!"
mkNoScope n@ProfNote{} = n {profNoteScope = False}
@@ -1174,7 +1189,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 :: GenTickish pass id -> Bool
+tickishIsCode :: GenTickish pass -> Bool
tickishIsCode SourceNote{} = False
tickishIsCode _tickish = True -- all the rest for now
@@ -1214,7 +1229,7 @@ data TickishPlacement =
deriving (Eq)
-- | Placement behaviour we want for the ticks
-tickishPlace :: Tickish id -> TickishPlacement
+tickishPlace :: GenTickish pass -> TickishPlacement
tickishPlace n@ProfNote{}
| profNoteCount n = PlaceRuntime
| otherwise = PlaceCostCentre
@@ -1224,7 +1239,8 @@ tickishPlace SourceNote{} = PlaceNonLam
-- | Returns whether one tick "contains" the other one, therefore
-- making the second tick redundant.
-tickishContains :: Eq b => Tickish b -> Tickish b -> Bool
+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
@@ -2237,8 +2253,8 @@ stripNArgs _ _ = Nothing
-- | Like @collectArgs@, but also collects looks through floatable
-- ticks if it means that we can find more arguments.
-collectArgsTicks :: (Tickish Id -> Bool) -> Expr b
- -> (Expr b, [Arg b], [Tickish Id])
+collectArgsTicks :: (Tickish -> Bool) -> Expr b
+ -> (Expr b, [Arg b], [Tickish])
collectArgsTicks skipTick expr
= go expr [] []
where
@@ -2323,7 +2339,7 @@ data AnnExpr' bndr annot
| AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
| AnnCast (AnnExpr bndr annot) (annot, Coercion)
-- Put an annotation on the (root of) the coercion
- | AnnTick (Tickish Id) (AnnExpr bndr annot)
+ | AnnTick Tickish (AnnExpr bndr annot)
| AnnType Type
| AnnCoercion Coercion
@@ -2344,8 +2360,8 @@ collectAnnArgs expr
go (_, AnnApp f a) as = go f (a:as)
go e as = (e, as)
-collectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a
- -> (AnnExpr b a, [AnnExpr b a], [Tickish Var])
+collectAnnArgsTicks :: (Tickish -> Bool) -> AnnExpr b a
+ -> (AnnExpr b a, [AnnExpr b a], [Tickish])
collectAnnArgsTicks tickishOk expr
= go expr [] []
where
diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs
index da661f1439..8baa5f26f8 100644
--- a/compiler/GHC/Core/FVs.hs
+++ b/compiler/GHC/Core/FVs.hs
@@ -6,6 +6,7 @@ Taken quite directly from the Peyton Jones/Lester paper.
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
-- | A module concerned with finding the free variables of an expression.
module GHC.Core.FVs (
@@ -289,7 +290,7 @@ rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV`
exprs_fvs :: [CoreExpr] -> FV
exprs_fvs exprs = mapUnionFV expr_fvs exprs
-tickish_fvs :: Tickish Id -> FV
+tickish_fvs :: Tickish -> FV
tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids
tickish_fvs _ = emptyFV
diff --git a/compiler/GHC/Core/Map/Expr.hs b/compiler/GHC/Core/Map/Expr.hs
index 03c0876138..b4a687f2c2 100644
--- a/compiler/GHC/Core/Map/Expr.hs
+++ b/compiler/GHC/Core/Map/Expr.hs
@@ -324,11 +324,11 @@ xtE (D env (Case e b ty as)) f m
in xtList (xtA env1) as f }
-- TODO: this seems a bit dodgy, see 'eqTickish'
-type TickishMap a = Map.Map (Tickish Id) a
-lkTickish :: Tickish Id -> TickishMap a -> Maybe a
+type TickishMap a = Map.Map Tickish a
+lkTickish :: Tickish -> TickishMap a -> Maybe a
lkTickish = lookupTM
-xtTickish :: Tickish Id -> XT a -> TickishMap a -> TickishMap a
+xtTickish :: Tickish -> XT a -> TickishMap a -> TickishMap a
xtTickish = alterTM
------------------------
diff --git a/compiler/GHC/Core/Opt/CallerCC.hs b/compiler/GHC/Core/Opt/CallerCC.hs
index 0807675d57..5a88482b42 100644
--- a/compiler/GHC/Core/Opt/CallerCC.hs
+++ b/compiler/GHC/Core/Opt/CallerCC.hs
@@ -82,7 +82,7 @@ doExpr env e@(Var v)
top:_ -> nameSrcSpan $ varName top
_ -> noSrcSpan
cc = NormalCC (ExprCC ccIdx) ccName (thisModule env) span
- tick :: Tickish Id
+ tick :: Tickish
tick = ProfNote cc True True
pure $ Tick tick e
| otherwise = pure e
diff --git a/compiler/GHC/Core/Opt/FloatOut.hs b/compiler/GHC/Core/Opt/FloatOut.hs
index 26a7c261bf..b8b434292f 100644
--- a/compiler/GHC/Core/Opt/FloatOut.hs
+++ b/compiler/GHC/Core/Opt/FloatOut.hs
@@ -738,7 +738,7 @@ atJoinCeiling (fs, floats, expr')
where
(floats', ceils) = partitionAtJoinCeiling floats
-wrapTick :: Tickish Id -> FloatBinds -> FloatBinds
+wrapTick :: Tickish -> FloatBinds -> FloatBinds
wrapTick t (FB tops ceils defns)
= FB (mapBag wrap_bind tops) (wrap_defns ceils)
(M.map (M.map wrap_defns) defns)
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index 74fe628a49..96c63f11a7 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -2055,7 +2055,7 @@ Constructors are rather like lambdas in this way.
-}
occAnalApp :: OccEnv
- -> (Expr CoreBndr, [Arg CoreBndr], [Tickish Id])
+ -> (Expr CoreBndr, [Arg CoreBndr], [Tickish])
-> (UsageDetails, Expr CoreBndr)
-- Naked variables (not applied) end up here too
occAnalApp env (Var fun, args, ticks)
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index c85b39754e..a9b5eabc30 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -981,7 +981,7 @@ ticks. More often than not, other references will be unfoldings of
x_exported, and therefore carry the tick anyway.
-}
-type IndEnv = IdEnv (Id, [Tickish Var]) -- Maps local_id -> exported_id, ticks
+type IndEnv = IdEnv (Id, [Tickish]) -- Maps local_id -> exported_id, ticks
shortOutIndirections :: CoreProgram -> CoreProgram
shortOutIndirections binds
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index f137534ec0..d3522f5478 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -5,6 +5,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates -Wno-incomplete-uni-patterns #-}
module GHC.Core.Opt.Simplify ( simplTopBinds, simplExpr, simplRules ) where
@@ -1160,7 +1161,7 @@ simplCoercion env co
-- long as this is a non-scoping tick, to let case and application
-- optimisations apply.
-simplTick :: SimplEnv -> Tickish Id -> InExpr -> SimplCont
+simplTick :: SimplEnv -> Tickish -> InExpr -> SimplCont
-> SimplM (SimplFloats, OutExpr)
simplTick env tickish expr cont
-- A scoped tick turns into a continuation, so that we can spot
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 2e27466c55..a8b16f8ba3 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -166,7 +166,7 @@ data SimplCont
, sc_cont :: SimplCont }
| TickIt -- (TickIt t K)[e] = K[ tick t e ]
- (Tickish Id) -- Tick tickish <hole>
+ Tickish -- Tick tickish <hole>
SimplCont
type StaticEnv = SimplEnv -- Just the static part is relevant
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 63e52ce258..ee08e31eb5 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -1125,7 +1125,7 @@ specLam env bndrs body
; return (mkLams bndrs (wrapDictBindsE dumped_dbs body'), free_uds) }
--------------
-specTickish :: SpecEnv -> Tickish Id -> Tickish Id
+specTickish :: SpecEnv -> Tickish -> Tickish
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.
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index 820f1f1785..06c35c1d28 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -1,6 +1,8 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -648,7 +650,7 @@ pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
-----------------------------------------------------
-}
-instance Outputable id => Outputable (GenTickish pass id) where
+instance Outputable (XTickishId pass) => Outputable (GenTickish pass) where
ppr (HpcTick modl ix) =
hcat [text "hpc<",
ppr modl, comma,
diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs
index 4dafc9c2e8..ce145b1c9c 100644
--- a/compiler/GHC/Core/Seq.hs
+++ b/compiler/GHC/Core/Seq.hs
@@ -21,7 +21,7 @@ import GHC.Types.Var.Set( seqDVarSet )
import GHC.Types.Var( varType, tyVarKind )
import GHC.Core.Type( seqType, isTyVar )
import GHC.Core.Coercion( seqCo )
-import GHC.Types.Id( Id, idInfo )
+import GHC.Types.Id( idInfo )
-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
-- compiler
@@ -71,7 +71,7 @@ seqExprs :: [CoreExpr] -> ()
seqExprs [] = ()
seqExprs (e:es) = seqExpr e `seq` seqExprs es
-seqTickish :: Tickish Id -> ()
+seqTickish :: Tickish -> ()
seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
seqTickish HpcTick{} = ()
seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 81bbc9247e..07b77a5d12 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -1322,7 +1322,7 @@ Currently, it is used in GHC.Core.Rules.match, and is required to make
-}
exprIsLambda_maybe :: InScopeEnv -> CoreExpr
- -> Maybe (Var, CoreExpr,[Tickish Id])
+ -> Maybe (Var, CoreExpr,[Tickish])
-- See Note [exprIsLambda_maybe]
-- The simple case: It is a lambda already
diff --git a/compiler/GHC/Core/Stats.hs b/compiler/GHC/Core/Stats.hs
index 46d5af5106..a25fd7b108 100644
--- a/compiler/GHC/Core/Stats.hs
+++ b/compiler/GHC/Core/Stats.hs
@@ -116,7 +116,7 @@ exprSize (Tick n e) = tickSize n + exprSize e
exprSize (Type _) = 1
exprSize (Coercion _) = 1
-tickSize :: Tickish Id -> Int
+tickSize :: Tickish -> Int
tickSize (ProfNote _ _ _) = 1
tickSize _ = 1
diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 7110208d79..bcf5790b99 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -717,7 +717,7 @@ substDVarSet subst fvs
| otherwise = tyCoFVsOfType (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc
------------------
-substTickish :: Subst -> Tickish Id -> Tickish Id
+substTickish :: Subst -> Tickish -> Tickish
substTickish subst (Breakpoint ext n ids)
= Breakpoint ext n (map do_one ids)
where
diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index 3e71d2c5b2..2c4b0b9203 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/compiler/GHC/Core/Tidy.hs
@@ -88,7 +88,7 @@ tidyAlt env (Alt con vs rhs)
(Alt con vs (tidyExpr env' rhs))
------------ Tickish --------------
-tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
+tidyTickish :: TidyEnv -> Tickish -> Tickish
tidyTickish env (Breakpoint ext ix ids)
= Breakpoint ext ix (map (tidyVarOcc env) ids)
tidyTickish _ other_tickish = other_tickish
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index f2772edd8b..35a32d4c5d 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -339,7 +339,7 @@ mkCast expr co
-- | Wraps the given expression in the source annotation, dropping the
-- annotation if possible.
-mkTick :: Tickish Id -> CoreExpr -> CoreExpr
+mkTick :: Tickish -> CoreExpr -> CoreExpr
mkTick t orig_expr = mkTick' id id orig_expr
where
-- Some ticks (cost-centres) can be split in two, with the
@@ -424,7 +424,7 @@ mkTick t orig_expr = mkTick' id id orig_expr
-- Catch-all: Annotate where we stand
_any -> top $ Tick t $ rest expr
-mkTicks :: [Tickish Id] -> CoreExpr -> CoreExpr
+mkTicks :: [Tickish] -> CoreExpr -> CoreExpr
mkTicks ticks expr = foldr mkTick expr ticks
isSaturatedConApp :: CoreExpr -> Bool
@@ -435,13 +435,13 @@ isSaturatedConApp e = go e []
go (Cast f _) as = go f as
go _ _ = False
-mkTickNoHNF :: Tickish Id -> CoreExpr -> CoreExpr
+mkTickNoHNF :: Tickish -> CoreExpr -> CoreExpr
mkTickNoHNF t e
| exprIsHNF e = tickHNFArgs t e
| otherwise = mkTick t e
-- push a tick into the arguments of a HNF (call or constructor app)
-tickHNFArgs :: Tickish Id -> CoreExpr -> CoreExpr
+tickHNFArgs :: Tickish -> CoreExpr -> CoreExpr
tickHNFArgs t e = push t e
where
push t (App f (Type u)) = App (push t f) (Type u)
@@ -449,28 +449,28 @@ tickHNFArgs t e = push t e
push _t e = e
-- | Strip ticks satisfying a predicate from top of an expression
-stripTicksTop :: (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b)
+stripTicksTop :: (Tickish -> Bool) -> Expr b -> ([Tickish], Expr b)
stripTicksTop p = go []
where go ts (Tick t e) | p t = go (t:ts) e
go ts other = (reverse ts, other)
-- | Strip ticks satisfying a predicate from top of an expression,
-- returning the remaining expression
-stripTicksTopE :: (Tickish Id -> Bool) -> Expr b -> Expr b
+stripTicksTopE :: (Tickish -> Bool) -> Expr b -> Expr b
stripTicksTopE p = go
where go (Tick t e) | p t = go e
go other = other
-- | Strip ticks satisfying a predicate from top of an expression,
-- returning the ticks
-stripTicksTopT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id]
+stripTicksTopT :: (Tickish -> Bool) -> Expr b -> [Tickish]
stripTicksTopT p = go []
where go ts (Tick t e) | p t = go (t:ts) e
go ts _ = ts
-- | Completely strip ticks satisfying a predicate from an
-- expression. Note this is O(n) in the size of the expression!
-stripTicksE :: (Tickish Id -> Bool) -> Expr b -> Expr b
+stripTicksE :: (Tickish -> Bool) -> Expr b -> Expr b
stripTicksE p expr = go expr
where go (App e a) = App (go e) (go a)
go (Lam b e) = Lam b (go e)
@@ -486,7 +486,7 @@ stripTicksE p expr = go expr
go_b (b, e) = (b, go e)
go_a (Alt c bs e) = Alt c bs (go e)
-stripTicksT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id]
+stripTicksT :: (Tickish -> Bool) -> Expr b -> [Tickish]
stripTicksT p expr = fromOL $ go expr
where go (App e a) = go e `appOL` go a
go (Lam _ e) = go e
@@ -2103,7 +2103,7 @@ cheapEqExpr :: Expr b -> Expr b -> Bool
cheapEqExpr = cheapEqExpr' (const False)
-- | Cheap expression equality test, can ignore ticks by type.
-cheapEqExpr' :: (Tickish Id -> Bool) -> Expr b -> Expr b -> Bool
+cheapEqExpr' :: (Tickish -> Bool) -> Expr b -> Expr b -> Bool
{-# INLINE cheapEqExpr' #-}
cheapEqExpr' ignoreTick e1 e2
= go e1 e2
@@ -2167,7 +2167,7 @@ eqExpr in_scope e1 e2
go_alt env (Alt c1 bs1 e1) (Alt c2 bs2 e2)
= c1 == c2 && go (rnBndrs2 env bs1 bs2) e1 e2
-eqTickish :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool
+eqTickish :: RnEnv2 -> Tickish -> Tickish -> Bool
eqTickish env (Breakpoint _ lid lids) (Breakpoint _ rid rids)
= lid == rid && map (rnOccL env) lids == map (rnOccR env) rids
eqTickish _ l r = l == r
@@ -2483,7 +2483,7 @@ tryEtaReduce bndrs body
-> Type -- Type of the function to which the argument is applied
-> Maybe (Coercion -- Of type (arg_t -> t1 ~ bndr_t -> t2)
-- (and similarly for tyvars, coercion args)
- , [Tickish Var])
+ , [Tickish])
-- See Note [Eta reduction with casted arguments]
ok_arg bndr (Type ty) co _
| Just tv <- getTyVar_maybe ty
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index d48686b615..ac3ddf0207 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -561,7 +561,7 @@ toIfaceOneShot id | isId id
= IfaceNoOneShot
---------------------
-toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
+toIfaceTickish :: Tickish -> Maybe IfaceTickish
toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
toIfaceTickish (HpcTick modl ix) = Just (IfaceHpcTick modl ix)
toIfaceTickish (SourceNote src names) = Just (IfaceSource src names)
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 7b930b9c01..327e58a860 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -525,7 +525,7 @@ mkStgAltType bndr alts
coreToStgApp :: Id -- Function
-> [CoreArg] -- Arguments
- -> [Tickish Id] -- Debug ticks
+ -> [Tickish] -- Debug ticks
-> CtsM StgExpr
coreToStgApp f args ticks = do
(args', ticks') <- coreToStgArgs args
@@ -585,7 +585,7 @@ coreToStgApp f args ticks = do
-- This is the guy that turns applications into A-normal form
-- ---------------------------------------------------------------------------
-coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish Id])
+coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish])
coreToStgArgs []
= return ([], [])
@@ -965,7 +965,7 @@ myCollectBinders expr
-- | Precondition: argument expression is an 'App', and there is a 'Var' at the
-- head of the 'App' chain.
-myCollectArgs :: CoreExpr -> (Id, [CoreArg], [Tickish Id])
+myCollectArgs :: CoreExpr -> (Id, [CoreArg], [Tickish])
myCollectArgs expr
= go expr [] []
where
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index 21c1fb0272..af5a6bcdc3 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -731,7 +731,7 @@ rhsToBody expr = return (emptyFloats, expr)
data ArgInfo = CpeApp CoreArg
| CpeCast Coercion
- | CpeTick (Tickish Id)
+ | CpeTick Tickish
instance Outputable ArgInfo where
ppr (CpeApp arg) = text "app" <+> ppr arg
@@ -1369,7 +1369,7 @@ data FloatingBind
-- but lifted binding
-- | See Note [Floating Ticks in CorePrep]
- | FloatTick (Tickish Id)
+ | FloatTick Tickish
data Floats = Floats OkToSpec (OrdList FloatingBind)
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 726b69a69a..d7b12b4c40 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -385,7 +385,7 @@ addTickLHsBind var_bind@(L _ (VarBind {})) = return var_bind
addTickLHsBind patsyn_bind@(L _ (PatSynBind {})) = return patsyn_bind
bindTick
- :: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
+ :: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe Tickish)
bindTick density name pos fvs = do
decl_path <- getPathEntry
let
@@ -1198,7 +1198,7 @@ allocTickBox boxLabel countEntries topOnly pos m =
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
allocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars
- -> TM (Maybe (Tickish Id))
+ -> TM (Maybe Tickish)
allocATickBox boxLabel countEntries topOnly pos fvs =
ifGoodTickSrcSpan pos (do
let
@@ -1212,7 +1212,7 @@ allocATickBox boxLabel countEntries topOnly pos fvs =
mkTickish :: BoxLabel -> Bool -> Bool -> SrcSpan -> OccEnv Id -> [String]
- -> TM (Tickish Id)
+ -> TM Tickish
mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
let ids = filter (not . isUnliftedType . idType) $ occEnvElts fvs
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 8d0eb816c8..eee4a12d2b 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -728,7 +728,7 @@ work out well:
-}
-- Remark: pattern selectors only occur in unrestricted patterns so we are free
-- to select Many as the multiplicity of every let-expression introduced.
-mkSelectorBinds :: [[Tickish Id]] -- ^ ticks to add, possibly
+mkSelectorBinds :: [[Tickish]] -- ^ ticks to add, possibly
-> LPat GhcTc -- ^ The pattern
-> CoreExpr -- ^ Expression to which the pattern is bound
-> DsM (Id,[(Id,CoreExpr)])
@@ -991,7 +991,7 @@ mk_fail_msg dflags ctx pat
* *
********************************************************************* -}
-mkOptTickBox :: [Tickish Id] -> CoreExpr -> CoreExpr
+mkOptTickBox :: [Tickish] -> CoreExpr -> CoreExpr
mkOptTickBox = flip (foldr Tick)
mkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index 26694c1db4..71cbc26afc 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1533,7 +1533,7 @@ tcIfaceExpr (IfaceTick tickish expr) = do
return (Tick tickish' expr')
-------------------------
-tcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id)
+tcIfaceTickish :: IfaceTickish -> IfM lcl Tickish
tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix)
tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push)
tcIfaceTickish (IfaceSource src name) = return (SourceNote src name)
diff --git a/compiler/GHC/Stg/Debug.hs b/compiler/GHC/Stg/Debug.hs
index 0fea7a0d72..46206d786e 100644
--- a/compiler/GHC/Stg/Debug.hs
+++ b/compiler/GHC/Stg/Debug.hs
@@ -6,10 +6,10 @@ module GHC.Stg.Debug(collectDebugInformation) where
import GHC.Prelude
-import GHC.Core
import GHC.Stg.Syntax
import GHC.Types.Id
+import GHC.Types.Tickish
import GHC.Core.DataCon
import GHC.Types.IPE
import GHC.Unit.Module
@@ -136,7 +136,7 @@ recordStgIdPosition id best_span ss = do
let mbspan = (\(SpanWithLabel rss d) -> (rss, d)) <$> (best_span <|> cc <|> ss)
lift $ modify (\env -> env { provClosure = addToUniqMap (provClosure env) (idName id) (idType id, mbspan) })
-numberDataCon :: DataCon -> [Tickish Id] -> M ConstructorNumber
+numberDataCon :: DataCon -> [StgTickish] -> M ConstructorNumber
-- Unboxed tuples and sums do not allocate so they
-- have no info tables.
numberDataCon dc _ | isUnboxedTupleDataCon dc = return NoNumber
@@ -155,7 +155,7 @@ numberDataCon dc ts = do
Nothing -> NoNumber
Just res -> Numbered (fst (NE.head res))
-selectTick :: [Tickish Id] -> Maybe SpanWithLabel
+selectTick :: [StgTickish] -> Maybe SpanWithLabel
selectTick [] = Nothing
selectTick (SourceNote rss d : ts ) = selectTick ts <|> Just (SpanWithLabel rss d)
selectTick (_:ts) = selectTick ts
diff --git a/compiler/GHC/Stg/FVs.hs b/compiler/GHC/Stg/FVs.hs
index 3385f2e275..a3d8686507 100644
--- a/compiler/GHC/Stg/FVs.hs
+++ b/compiler/GHC/Stg/FVs.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+
{- |
Non-global free variable analysis on STG terms. This pass annotates
non-top-level closure bindings with captured variables. Global variables are not
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 0f2dd258e2..72d6760f6f 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -175,13 +175,13 @@ stgArgType (StgLitArg lit) = literalType lit
-- | Strip ticks of a given type from an STG expression.
-stripStgTicksTop :: (StgTickish Id -> Bool) -> GenStgExpr p -> ([StgTickish Id], GenStgExpr p)
+stripStgTicksTop :: (StgTickish -> Bool) -> GenStgExpr p -> ([StgTickish], 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 :: (StgTickish Id -> Bool) -> GenStgExpr p -> GenStgExpr p
+stripStgTicksTopE :: (StgTickish -> 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
- (StgTickish Id)
+ StgTickish
(GenStgExpr pass) -- sub expression
-- END of GenStgExpr
@@ -420,7 +420,7 @@ important):
DataCon -- Constructor. Never an unboxed tuple or sum, as those
-- are not allocated.
ConstructorNumber
- [Tickish Id]
+ [StgTickish]
[StgArg] -- Args
{-
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index 91853b5799..8047571d9f 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 :: StgTickish Id -> FCode ()
+cgTick :: StgTickish -> 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 bc98bd279f..1310649d54 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -676,7 +676,7 @@ tcPolyCheck _prag_fn sig bind
= pprPanic "tcPolyCheck" (ppr sig $$ ppr bind)
funBindTicks :: SrcSpan -> TcId -> Module -> [LSig GhcRn]
- -> TcM [Tickish TcId]
+ -> TcM [Tickish]
funBindTicks loc fun_id mod sigs
| (mb_cc_str : _) <- [ cc_name | L _ (SCCFunSig _ _ _ cc_name) <- sigs ]
-- this can only be a singleton list, as duplicate pragmas are rejected