Skip to content

Commit

Permalink
Move seqExpr, seqIdInfo etc to CoreUtils
Browse files Browse the repository at this point in the history 
Refactoring only : it just brings some scattered "seq" code together
  • Loading branch information
Simon Peyton Jones committed Jun 1, 2015
1 parent 928f536 commit 5eee6a1
Show file tree
Hide file tree
Showing 5 changed files with 112 additions and 111 deletions.
2 changes: 1 addition & 1 deletion compiler/basicTypes/Id.hs
View file
Expand Up @@ -198,7 +198,7 @@ lazySetIdInfo :: Id -> IdInfo -> Id
lazySetIdInfo = Var.lazySetIdInfo

setIdInfo :: Id -> IdInfo -> Id
setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)
setIdInfo id info = info `seq` (lazySetIdInfo id info)
-- Try to avoid spack leaks by seq'ing

modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
Expand Down
38 changes: 1 addition & 37 deletions compiler/basicTypes/IdInfo.hs
View file
Expand Up @@ -15,7 +15,6 @@ module IdInfo (
-- * The IdInfo type
IdInfo, -- Abstract
vanillaIdInfo, noCafIdInfo,
seqIdInfo, megaSeqIdInfo,

-- ** The OneShotInfo type
OneShotInfo(..),
Expand Down Expand Up @@ -56,7 +55,7 @@ module IdInfo (
SpecInfo(..),
emptySpecInfo,
isEmptySpecInfo, specInfoFreeVars,
specInfoRules, seqSpecInfo, setSpecInfoHead,
specInfoRules, setSpecInfoHead,
specInfo, setSpecInfo,

-- ** The CAFInfo type
Expand Down Expand Up @@ -194,35 +193,6 @@ data IdInfo
-- n <=> all calls have at least n arguments
}

-- | Just evaluate the 'IdInfo' to WHNF
seqIdInfo :: IdInfo -> ()
seqIdInfo (IdInfo {}) = ()

-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
-- compiler
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
= seqSpecInfo (specInfo info) `seq`

-- Omitting this improves runtimes a little, presumably because
-- some unfoldings are not calculated at all
-- seqUnfolding (unfoldingInfo info) `seq`

seqDemandInfo (demandInfo info) `seq`
seqStrictnessInfo (strictnessInfo info) `seq`
seqCaf (cafInfo info) `seq`
seqOneShot (oneShotInfo info) `seq`
seqOccInfo (occInfo info)

seqOneShot :: OneShotInfo -> ()
seqOneShot l = l `seq` ()

seqStrictnessInfo :: StrictSig -> ()
seqStrictnessInfo ty = seqStrictSig ty

seqDemandInfo :: Demand -> ()
seqDemandInfo dmd = seqDemand dmd

-- Setters

setSpecInfo :: IdInfo -> SpecInfo -> IdInfo
Expand Down Expand Up @@ -400,9 +370,6 @@ setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
setSpecInfoHead fn (SpecInfo rules fvs)
= SpecInfo (map (setRuleIdName fn) rules) fvs

seqSpecInfo :: SpecInfo -> ()
seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs

{-
************************************************************************
* *
Expand Down Expand Up @@ -434,9 +401,6 @@ mayHaveCafRefs :: CafInfo -> Bool
mayHaveCafRefs MayHaveCafRefs = True
mayHaveCafRefs _ = False

seqCaf :: CafInfo -> ()
seqCaf c = c `seq` ()

instance Outputable CafInfo where
ppr = ppCafInfo

Expand Down
73 changes: 1 addition & 72 deletions compiler/coreSyn/CoreSyn.hs
View file
Expand Up @@ -58,9 +58,6 @@ module CoreSyn (
isClosedUnfolding, hasSomeUnfolding,
canUnfold, neverUnfoldGuidance, isStableSource,

-- * Strictness
seqExpr, seqExprs, seqUnfolding,

-- * Annotated expression data types
AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,

Expand All @@ -75,7 +72,7 @@ module CoreSyn (
RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,

-- ** Operations on 'CoreRule's
seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
ruleArity, ruleName, ruleIdName, ruleActivation,
setRuleIdName,
isBuiltinRule, isLocalRule, isAutoRule,

Expand Down Expand Up @@ -1023,19 +1020,6 @@ evaldUnfolding = OtherCon []
mkOtherCon :: [AltCon] -> Unfolding
mkOtherCon = OtherCon

seqUnfolding :: Unfolding -> ()
seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
uf_is_value = b1, uf_is_work_free = b2,
uf_expandable = b3, uf_is_conlike = b4,
uf_guidance = g})
= seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g

seqUnfolding _ = ()

seqGuidance :: UnfoldingGuidance -> ()
seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
seqGuidance _ = ()

isStableSource :: UnfoldingSource -> Bool
-- Keep the unfolding template
isStableSource InlineCompulsory = True
Expand Down Expand Up @@ -1571,61 +1555,6 @@ valBndrCount = count isId
valArgCount :: [Arg b] -> Int
valArgCount = count isValArg

{-
************************************************************************
* *
\subsection{Seq stuff}
* *
************************************************************************
-}

seqExpr :: CoreExpr -> ()
seqExpr (Var v) = v `seq` ()
seqExpr (Lit lit) = lit `seq` ()
seqExpr (App f a) = seqExpr f `seq` seqExpr a
seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
seqExpr (Let b e) = seqBind b `seq` seqExpr e
seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
seqExpr (Cast e co) = seqExpr e `seq` seqCo co
seqExpr (Tick n e) = seqTickish n `seq` seqExpr e
seqExpr (Type t) = seqType t
seqExpr (Coercion co) = seqCo co

seqExprs :: [CoreExpr] -> ()
seqExprs [] = ()
seqExprs (e:es) = seqExpr e `seq` seqExprs es

seqTickish :: Tickish Id -> ()
seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
seqTickish HpcTick{} = ()
seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
seqTickish SourceNote{} = ()

seqBndr :: CoreBndr -> ()
seqBndr b = b `seq` ()

seqBndrs :: [CoreBndr] -> ()
seqBndrs [] = ()
seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs

seqBind :: Bind CoreBndr -> ()
seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
seqBind (Rec prs) = seqPairs prs

seqPairs :: [(CoreBndr, CoreExpr)] -> ()
seqPairs [] = ()
seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs

seqAlts :: [CoreAlt] -> ()
seqAlts [] = ()
seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts

seqRules :: [CoreRule] -> ()
seqRules [] = ()
seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
= seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
seqRules (BuiltinRule {} : rules) = seqRules rules

{-
************************************************************************
* *
Expand Down
108 changes: 108 additions & 0 deletions compiler/coreSyn/CoreUtils.hs
View file
Expand Up @@ -39,6 +39,10 @@ module CoreUtils (
-- * Eta reduction
tryEtaReduce,

-- * Seq
seqExpr, seqExprs, seqUnfolding, seqRules,
seqIdInfo, megaSeqIdInfo, seqSpecInfo, seqBinds,

-- * Manipulating data constructors and types
applyTypeToArgs, applyTypeToArg,
dataConRepInstPat, dataConRepFSInstPat,
Expand All @@ -62,6 +66,8 @@ import Name
import Literal
import DataCon
import PrimOp
import Demand( seqDemand, seqStrictSig )
import BasicTypes( seqOccInfo )
import Id
import IdInfo
import Type
Expand Down Expand Up @@ -1694,6 +1700,108 @@ locBind loc b1 b2 diffs = map addLoc diffs
bindLoc | b1 == b2 = ppr b1
| otherwise = ppr b1 <> char '/' <> ppr b2

{-
************************************************************************
* *
\subsection{Seq stuff}
* *
************************************************************************
-}

seqExpr :: CoreExpr -> ()
seqExpr (Var v) = v `seq` ()
seqExpr (Lit lit) = lit `seq` ()
seqExpr (App f a) = seqExpr f `seq` seqExpr a
seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
seqExpr (Let b e) = seqBind b `seq` seqExpr e
seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
seqExpr (Cast e co) = seqExpr e `seq` seqCo co
seqExpr (Tick n e) = seqTickish n `seq` seqExpr e
seqExpr (Type t) = seqType t
seqExpr (Coercion co) = seqCo co

seqExprs :: [CoreExpr] -> ()
seqExprs [] = ()
seqExprs (e:es) = seqExpr e `seq` seqExprs es

seqTickish :: Tickish Id -> ()
seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
seqTickish HpcTick{} = ()
seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
seqTickish SourceNote{} = ()

seqBndr :: CoreBndr -> ()
seqBndr b | isTyVar b = seqType (tyVarKind b)
| otherwise = seqType (varType b) `seq`
megaSeqIdInfo (idInfo b)

seqBndrs :: [CoreBndr] -> ()
seqBndrs [] = ()
seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs

seqBinds :: [Bind CoreBndr] -> ()
seqBinds bs = foldr (seq . seqBind) () bs

seqBind :: Bind CoreBndr -> ()
seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
seqBind (Rec prs) = seqPairs prs

seqPairs :: [(CoreBndr, CoreExpr)] -> ()
seqPairs [] = ()
seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs

seqAlts :: [CoreAlt] -> ()
seqAlts [] = ()
seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts

seqRules :: [CoreRule] -> ()
seqRules [] = ()
seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
= seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
seqRules (BuiltinRule {} : rules) = seqRules rules

seqUnfolding :: Unfolding -> ()
seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
uf_is_value = b1, uf_is_work_free = b2,
uf_expandable = b3, uf_is_conlike = b4,
uf_guidance = g})
= seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g

seqUnfolding _ = ()

seqGuidance :: UnfoldingGuidance -> ()
seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
seqGuidance _ = ()

-- | Just evaluate the 'IdInfo' to WHNF
seqIdInfo :: IdInfo -> ()
seqIdInfo info = info `seq` ()

-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
-- compiler
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
= seqSpecInfo (specInfo info) `seq`

-- Omitting this improves runtimes a little, presumably because
-- some unfoldings are not calculated at all
-- seqUnfolding (unfoldingInfo info) `seq`

seqDemand (demandInfo info) `seq`
seqStrictSig (strictnessInfo info) `seq`
seqCaf (cafInfo info) `seq`
seqOneShot (oneShotInfo info) `seq`
seqOccInfo (occInfo info)

seqOneShot :: OneShotInfo -> ()
seqOneShot l = l `seq` ()

seqSpecInfo :: SpecInfo -> ()
seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs

seqCaf :: CafInfo -> ()
seqCaf c = c `seq` ()

{-
************************************************************************
* *
Expand Down
2 changes: 1 addition & 1 deletion compiler/coreSyn/PprCore.hs
View file
Expand Up @@ -340,7 +340,7 @@ pprIdBndrInfo info
= sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressIdInfo dflags
then empty
else megaSeqIdInfo info `seq` doc -- The seq is useful for poking on black holes
else info `seq` doc -- The seq is useful for poking on black holes
where
prag_info = inlinePragInfo info
occ_info = occInfo info
Expand Down

0 comments on commit 5eee6a1

Please sign in to comment.