diff options
author | Luite Stegeman <stegeman@gmail.com> | 2021-01-24 14:16:16 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-20 07:49:15 -0400 |
commit | 0107f3568d060b4c979aa3740465c4f6ca4c2bba (patch) | |
tree | f17a570bedb397e1211b69cf03cd1cb05e3148cf | |
parent | 26328a688183e3af49b5ac315b27afc2691bbc46 (diff) | |
download | haskell-0107f3568d060b4c979aa3740465c4f6ca4c2bba.tar.gz |
rename Tickish to CoreTickish
26 files changed, 66 insertions, 59 deletions
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs index 2b9da7a1dd..e00986566d 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, CmmTickish, XTickishId, + GenTickish(..), CoreTickish, StgTickish, CmmTickish, XTickishId, TickishScoping(..), TickishPlacement(..), CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr, @@ -124,7 +124,6 @@ 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 @@ -133,6 +132,8 @@ 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 @@ -275,7 +276,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 (Expr b) + | Tick CoreTickish (Expr b) | Type Type | Coercion Coercion deriving Data @@ -966,7 +967,7 @@ type instance XTickishId 'TickishCore = Id type instance XTickishId 'TickishStg = Id type instance XTickishId 'TickishCmm = NoExtField -type Tickish = GenTickish 'TickishCore +type CoreTickish = GenTickish 'TickishCore type StgTickish = GenTickish 'TickishStg -- | Tickish in Cmm context (annotations only) type CmmTickish = GenTickish 'TickishCmm @@ -2253,8 +2254,8 @@ stripNArgs _ _ = Nothing -- | Like @collectArgs@, but also collects looks through floatable -- ticks if it means that we can find more arguments. -collectArgsTicks :: (Tickish -> Bool) -> Expr b - -> (Expr b, [Arg b], [Tickish]) +collectArgsTicks :: (CoreTickish -> Bool) -> Expr b + -> (Expr b, [Arg b], [CoreTickish]) collectArgsTicks skipTick expr = go expr [] [] where @@ -2339,7 +2340,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 (AnnExpr bndr annot) + | AnnTick CoreTickish (AnnExpr bndr annot) | AnnType Type | AnnCoercion Coercion @@ -2360,8 +2361,8 @@ collectAnnArgs expr go (_, AnnApp f a) as = go f (a:as) go e as = (e, as) -collectAnnArgsTicks :: (Tickish -> Bool) -> AnnExpr b a - -> (AnnExpr b a, [AnnExpr b a], [Tickish]) +collectAnnArgsTicks :: (CoreTickish -> Bool) -> AnnExpr b a + -> (AnnExpr b a, [AnnExpr b a], [CoreTickish]) collectAnnArgsTicks tickishOk expr = go expr [] [] where diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs index 8baa5f26f8..c1b4a49bbb 100644 --- a/compiler/GHC/Core/FVs.hs +++ b/compiler/GHC/Core/FVs.hs @@ -290,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 -> FV +tickish_fvs :: CoreTickish -> 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 b4a687f2c2..04c786deec 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 a -lkTickish :: Tickish -> TickishMap a -> Maybe a +type TickishMap a = Map.Map CoreTickish a +lkTickish :: CoreTickish -> TickishMap a -> Maybe a lkTickish = lookupTM -xtTickish :: Tickish -> XT a -> TickishMap a -> TickishMap a +xtTickish :: CoreTickish -> 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 5a88482b42..68875dc18f 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 + tick :: CoreTickish 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 b8b434292f..d0a544c020 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 -> FloatBinds -> FloatBinds +wrapTick :: CoreTickish -> 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 96c63f11a7..32853b6aff 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]) + -> (Expr CoreBndr, [Arg CoreBndr], [CoreTickish]) -> (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 a9b5eabc30..0493ad911a 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]) -- Maps local_id -> exported_id, ticks +type IndEnv = IdEnv (Id, [CoreTickish]) -- 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 d3522f5478..8090ddb369 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -1161,7 +1161,7 @@ simplCoercion env co -- long as this is a non-scoping tick, to let case and application -- optimisations apply. -simplTick :: SimplEnv -> Tickish -> InExpr -> SimplCont +simplTick :: SimplEnv -> CoreTickish -> 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 a8b16f8ba3..ec83c25cc4 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 -- Tick tickish <hole> + CoreTickish -- 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 ee08e31eb5..c18785cee1 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 -> Tickish +specTickish :: SpecEnv -> CoreTickish -> CoreTickish 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 06c35c1d28..04e51aacde 100644 --- a/compiler/GHC/Core/Ppr.hs +++ b/compiler/GHC/Core/Ppr.hs @@ -1,6 +1,10 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} + +{- + these are needed for the Outputable instance for GenTickish, + since we need XTickishId to be Outputable. This should immediately + resolve to something like Id. + -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs index ce145b1c9c..35a87aab9a 100644 --- a/compiler/GHC/Core/Seq.hs +++ b/compiler/GHC/Core/Seq.hs @@ -71,7 +71,7 @@ seqExprs :: [CoreExpr] -> () seqExprs [] = () seqExprs (e:es) = seqExpr e `seq` seqExprs es -seqTickish :: Tickish -> () +seqTickish :: CoreTickish -> () 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 07b77a5d12..519638d25d 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]) + -> Maybe (Var, CoreExpr,[CoreTickish]) -- 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 a25fd7b108..e43e4e4471 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 -> Int +tickSize :: CoreTickish -> Int tickSize (ProfNote _ _ _) = 1 tickSize _ = 1 diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs index bcf5790b99..3ed3996488 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 -> Tickish +substTickish :: Subst -> CoreTickish -> CoreTickish 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 2c4b0b9203..c88cbdc0c4 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 -> Tickish +tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish 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 35a32d4c5d..5a4b6304f1 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 -> CoreExpr -> CoreExpr +mkTick :: CoreTickish -> 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] -> CoreExpr -> CoreExpr +mkTicks :: [CoreTickish] -> 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 -> CoreExpr -> CoreExpr +mkTickNoHNF :: CoreTickish -> 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 -> CoreExpr -> CoreExpr +tickHNFArgs :: CoreTickish -> 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 -> Bool) -> Expr b -> ([Tickish], Expr b) +stripTicksTop :: (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], 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 -> Bool) -> Expr b -> Expr b +stripTicksTopE :: (CoreTickish -> 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 -> Bool) -> Expr b -> [Tickish] +stripTicksTopT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish] 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 -> Bool) -> Expr b -> Expr b +stripTicksE :: (CoreTickish -> 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 -> Bool) -> Expr b -> [Tickish] +stripTicksT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish] 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 -> Bool) -> Expr b -> Expr b -> Bool +cheapEqExpr' :: (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool {-# INLINE cheapEqExpr' #-} cheapEqExpr' ignoreTick e1 e2 = go e1 e2 @@ -2167,9 +2167,11 @@ 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 -> Tickish -> Bool -eqTickish env (Breakpoint _ lid lids) (Breakpoint _ rid rids) - = lid == rid && map (rnOccL env) lids == map (rnOccR env) rids +eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool +eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids) + = lid == rid && + map (rnOccL env) lids == map (rnOccR env) rids && + lext == rext eqTickish _ l r = l == r -- | Finds differences between core expressions, modulo alpha and @@ -2483,7 +2485,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]) + , [CoreTickish]) -- 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 ac3ddf0207..48729ea00c 100644 --- a/compiler/GHC/CoreToIface.hs +++ b/compiler/GHC/CoreToIface.hs @@ -561,7 +561,7 @@ toIfaceOneShot id | isId id = IfaceNoOneShot --------------------- -toIfaceTickish :: Tickish -> Maybe IfaceTickish +toIfaceTickish :: CoreTickish -> 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 327e58a860..298288d45b 100644 --- a/compiler/GHC/CoreToStg.hs +++ b/compiler/GHC/CoreToStg.hs @@ -525,7 +525,7 @@ mkStgAltType bndr alts coreToStgApp :: Id -- Function -> [CoreArg] -- Arguments - -> [Tickish] -- Debug ticks + -> [CoreTickish] -- Debug ticks -> CtsM StgExpr coreToStgApp f args ticks = do (args', ticks') <- coreToStgArgs args @@ -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]) +myCollectArgs :: CoreExpr -> (Id, [CoreArg], [CoreTickish]) myCollectArgs expr = go expr [] [] where diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index af5a6bcdc3..02b5505d30 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 + | CpeTick CoreTickish 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 + | FloatTick CoreTickish data Floats = Floats OkToSpec (OrdList FloatingBind) diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs index d7b12b4c40..caeea519aa 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) + :: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe CoreTickish) 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) + -> TM (Maybe CoreTickish) 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 + -> TM CoreTickish 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 eee4a12d2b..817c69c184 100644 --- a/compiler/GHC/HsToCore/Utils.hs +++ b/compiler/GHC/HsToCore/Utils.hs @@ -728,9 +728,9 @@ 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]] -- ^ ticks to add, possibly - -> LPat GhcTc -- ^ The pattern - -> CoreExpr -- ^ Expression to which the pattern is bound +mkSelectorBinds :: [[CoreTickish]] -- ^ ticks to add, possibly + -> LPat GhcTc -- ^ The pattern + -> CoreExpr -- ^ Expression to which the pattern is bound -> DsM (Id,[(Id,CoreExpr)]) -- ^ Id the rhs is bound to, for desugaring strict -- binds (see Note [Desugar Strict binds] in "GHC.HsToCore.Binds") @@ -991,7 +991,7 @@ mk_fail_msg dflags ctx pat * * ********************************************************************* -} -mkOptTickBox :: [Tickish] -> CoreExpr -> CoreExpr +mkOptTickBox :: [CoreTickish] -> 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 71cbc26afc..e7123a8add 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 +tcIfaceTickish :: IfaceTickish -> IfM lcl CoreTickish 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/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs index 1310649d54..394b4b9c31 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, GenTickish (..)) +import GHC.Core (CoreTickish, GenTickish (..)) import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC)) import GHC.Driver.Session import GHC.Data.FastString @@ -676,7 +676,7 @@ tcPolyCheck _prag_fn sig bind = pprPanic "tcPolyCheck" (ppr sig $$ ppr bind) funBindTicks :: SrcSpan -> TcId -> Module -> [LSig GhcRn] - -> TcM [Tickish] + -> TcM [CoreTickish] 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 diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs index 6f7283be86..ebd93d3ecd 100644 --- a/compiler/Language/Haskell/Syntax/Binds.hs +++ b/compiler/Language/Haskell/Syntax/Binds.hs @@ -227,7 +227,7 @@ data HsBindLR idL idR fun_matches :: MatchGroup idR (LHsExpr idR), -- ^ The payload - fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any + fun_tick :: [CoreTickish] -- ^ Ticks to put on the rhs, if any } -- | Pattern Binding @@ -247,7 +247,7 @@ data HsBindLR idL idR pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars] pat_lhs :: LPat idL, pat_rhs :: GRHSs idR (LHsExpr idR), - pat_ticks :: ([Tickish Id], [[Tickish Id]]) + pat_ticks :: ([CoreTickish], [[CoreTickish]]) -- ^ Ticks to put on the rhs, if any, and ticks to put on -- the bound variables. } diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs index cb84d25489..5e8714faf4 100644 --- a/compiler/Language/Haskell/Syntax/Expr.hs +++ b/compiler/Language/Haskell/Syntax/Expr.hs @@ -595,7 +595,7 @@ data HsExpr p | HsTick (XTick p) - (Tickish (IdP p)) + CoreTickish (LHsExpr p) -- sub-expression | HsBinTick |