projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Tidy up computation of result discounts in CoreUnfold
[ghc-hetmet.git]
/
compiler
/
coreSyn
/
CorePrep.lhs
diff --git
a/compiler/coreSyn/CorePrep.lhs
b/compiler/coreSyn/CorePrep.lhs
index
2a5987c
..
738bf82
100644
(file)
--- a/
compiler/coreSyn/CorePrep.lhs
+++ b/
compiler/coreSyn/CorePrep.lhs
@@
-15,12
+15,12
@@
import PrelNames ( lazyIdKey, hasKey )
import CoreUtils
import CoreArity
import CoreFVs
import CoreUtils
import CoreArity
import CoreFVs
-import CoreLint
+import CoreMonad ( endPass )
import CoreSyn
import Type
import Coercion
import TyCon
import CoreSyn
import Type
import Coercion
import TyCon
-import NewDemand
+import Demand
import Var
import VarSet
import VarEnv
import Var
import VarSet
import VarEnv
@@
-147,7
+147,7
@@
corePrepPgm dflags binds data_tycons = do
floats2 <- corePrepTopBinds implicit_binds
return (deFloatTop (floats1 `appendFloats` floats2))
floats2 <- corePrepTopBinds implicit_binds
return (deFloatTop (floats1 `appendFloats` floats2))
- endPass dflags "CorePrep" Opt_D_dump_prep binds_out
+ endPass dflags "CorePrep" Opt_D_dump_prep binds_out []
return binds_out
corePrepExpr :: DynFlags -> CoreExpr -> IO CoreExpr
return binds_out
corePrepExpr :: DynFlags -> CoreExpr -> IO CoreExpr
@@
-244,7
+244,7
@@
cpeBind :: TopLevelFlag
-> UniqSM (CorePrepEnv, Floats)
cpeBind top_lvl env (NonRec bndr rhs)
= do { (_, bndr1) <- cloneBndr env bndr
-> UniqSM (CorePrepEnv, Floats)
cpeBind top_lvl env (NonRec bndr rhs)
= do { (_, bndr1) <- cloneBndr env bndr
- ; let is_strict = isStrictDmd (idNewDemandInfo bndr)
+ ; let is_strict = isStrictDmd (idDemandInfo bndr)
is_unlifted = isUnLiftedType (idType bndr)
; (floats, bndr2, rhs2) <- cpePair top_lvl NonRecursive
(is_strict || is_unlifted)
is_unlifted = isUnLiftedType (idType bndr)
; (floats, bndr2, rhs2) <- cpePair top_lvl NonRecursive
(is_strict || is_unlifted)
@@
-497,7
+497,7
@@
cpeApp env expr
; let v2 = lookupCorePrepEnv env v1
; return (Var v2, (Var v2, depth), idType v2, emptyFloats, stricts) }
where
; let v2 = lookupCorePrepEnv env v1
; return (Var v2, (Var v2, depth), idType v2, emptyFloats, stricts) }
where
- stricts = case idNewStrictness v of
+ stricts = case idStrictness v of
StrictSig (DmdType _ demands _)
| listLengthCmp demands depth /= GT -> demands
-- length demands <= depth
StrictSig (DmdType _ demands _)
| listLengthCmp demands depth /= GT -> demands
-- length demands <= depth
@@
-640,7
+640,6
@@
ignoreNote :: Note -> Bool
-- want to get this:
-- unzip = /\ab \xs. (__inline_me__ ...) a b xs
ignoreNote (CoreNote _) = True
-- want to get this:
-- unzip = /\ab \xs. (__inline_me__ ...) a b xs
ignoreNote (CoreNote _) = True
-ignoreNote InlineMe = True
ignoreNote _other = False
ignoreNote _other = False