summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Core')
-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
9 files changed, 22 insertions, 18 deletions
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
View Lorry Controller Status