diff options
Diffstat (limited to 'compiler/GHC/Stg')
-rw-r--r-- | compiler/GHC/Stg/Debug.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Stg/FVs.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Stg/Syntax.hs | 8 |
3 files changed, 9 insertions, 7 deletions
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 {- |