projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Be a bit more sensible about choosing external OccNames
[ghc-hetmet.git]
/
compiler
/
stranal
/
DmdAnal.lhs
diff --git
a/compiler/stranal/DmdAnal.lhs
b/compiler/stranal/DmdAnal.lhs
index
198e80b
..
6dc0fb7
100644
(file)
--- a/
compiler/stranal/DmdAnal.lhs
+++ b/
compiler/stranal/DmdAnal.lhs
@@
-25,10
+25,11
@@
import StaticFlags ( opt_MaxWorkerArgs )
import NewDemand -- All of it
import CoreSyn
import PprCore
import NewDemand -- All of it
import CoreSyn
import PprCore
-import CoreUtils ( exprIsHNF, exprIsTrivial, exprArity )
+import CoreUtils ( exprIsHNF, exprIsTrivial )
+import CoreArity ( exprArity )
import DataCon ( dataConTyCon )
import TyCon ( isProductTyCon, isRecursiveTyCon )
import DataCon ( dataConTyCon )
import TyCon ( isProductTyCon, isRecursiveTyCon )
-import Id ( Id, idType, idInlinePragma,
+import Id ( Id, idType, idInlineActivation,
isDataConWorkId, isGlobalId, idArity,
#ifdef OLD_STRICTNESS
idDemandInfo, idStrictness, idCprInfo, idName,
isDataConWorkId, isGlobalId, idArity,
#ifdef OLD_STRICTNESS
idDemandInfo, idStrictness, idCprInfo, idName,
@@
-267,7
+268,7
@@
dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)])
-- The insight is, of course, that a demand on y is a demand on the
-- scrutinee, so we need to `both` it with the scrut demand
-- The insight is, of course, that a demand on y is a demand on the
-- scrutinee, so we need to `both` it with the scrut demand
- alt_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isIdVar b])
+ alt_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isId b])
scrut_dmd = alt_dmd `both`
idNewDemandInfo case_bndr'
scrut_dmd = alt_dmd `both`
idNewDemandInfo case_bndr'
@@
-462,7
+463,7
@@
mkSigTy :: TopLevelFlag -> RecFlag -> Id -> CoreExpr -> DmdType -> (DmdEnv, Stri
mkSigTy top_lvl rec_flag id rhs dmd_ty
= mk_sig_ty never_inline thunk_cpr_ok rhs dmd_ty
where
mkSigTy top_lvl rec_flag id rhs dmd_ty
= mk_sig_ty never_inline thunk_cpr_ok rhs dmd_ty
where
- never_inline = isNeverActive (idInlinePragma id)
+ never_inline = isNeverActive (idInlineActivation id)
maybe_id_dmd = idNewDemandInfo_maybe id
-- Is Nothing the first time round
maybe_id_dmd = idNewDemandInfo_maybe id
-- Is Nothing the first time round
@@
-747,7
+748,7
@@
annotateLamIdBndr :: DmdType -- Demand type of body
annotateLamIdBndr dmd_ty@(DmdType fv ds res) id
-- For lambdas we add the demand to the argument demands
-- Only called for Ids
annotateLamIdBndr dmd_ty@(DmdType fv ds res) id
-- For lambdas we add the demand to the argument demands
-- Only called for Ids
- = ASSERT( isIdVar id )
+ = ASSERT( isId id )
(DmdType fv' (hacked_dmd:ds) res, setIdNewDemandInfo id hacked_dmd)
where
(fv', dmd) = removeFV fv id res
(DmdType fv' (hacked_dmd:ds) res, setIdNewDemandInfo id hacked_dmd)
where
(fv', dmd) = removeFV fv id res