diff options
author | simonpj@microsoft.com <unknown> | 2007-01-31 15:06:16 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2007-01-31 15:06:16 +0000 |
commit | 96cb07b5940f98f35ac292e40d0129db5d3748ce (patch) | |
tree | 124775cea518fb18ce6160c40e5c9b7b5e78f37c /compiler | |
parent | 49d454d8f8f0e1a83369ec12f8aafc1dcf80aea9 (diff) | |
download | haskell-96cb07b5940f98f35ac292e40d0129db5d3748ce.tar.gz |
Use Id.isStrictId
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/simplCore/LiberateCase.lhs | 3 | ||||
-rw-r--r-- | compiler/simplCore/SimplEnv.lhs | 11 | ||||
-rw-r--r-- | compiler/simplCore/SimplUtils.lhs | 2 | ||||
-rw-r--r-- | compiler/simplCore/Simplify.lhs | 4 |
4 files changed, 5 insertions, 15 deletions
diff --git a/compiler/simplCore/LiberateCase.lhs b/compiler/simplCore/LiberateCase.lhs index 31063d3b24..9b157340f6 100644 --- a/compiler/simplCore/LiberateCase.lhs +++ b/compiler/simplCore/LiberateCase.lhs @@ -90,7 +90,7 @@ Consider this: f = \ t -> case (v `cast` co) of V a b -> a : f t -Exactly the same optimistaion (unrolling one call to f) will work here, +Exactly the same optimisation (unrolling one call to f) will work here, despite the cast. See mk_alt_env in the Case branch of libCase. @@ -108,7 +108,6 @@ big. Data types ~~~~~~~~~~ - The ``level'' of a binder tells how many recursive defns lexically enclose the binding A recursive defn "encloses" its RHS, not its diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index 245f313e8f..3832f547de 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -9,8 +9,6 @@ module SimplEnv ( OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, InCoercion, OutCoercion, - isStrictBndr, - -- The simplifier mode setMode, getMode, @@ -92,13 +90,6 @@ type OutAlt = CoreAlt type OutArg = CoreArg \end{code} -\begin{code} -isStrictBndr :: Id -> Bool -isStrictBndr bndr - = ASSERT2( isId bndr, ppr bndr ) - isStrictDmd (idNewDemandInfo bndr) || isStrictType (idType bndr) -\end{code} - %************************************************************************ %* * \subsubsection{The @SimplEnv@ type} @@ -364,7 +355,7 @@ andFF FltLifted flt = flt classifyFF :: CoreBind -> FloatFlag classifyFF (Rec _) = FltLifted classifyFF (NonRec bndr rhs) - | not (isStrictBndr bndr) = FltLifted + | not (isStrictId bndr) = FltLifted | exprOkForSpeculation rhs = FltOkSpec | otherwise = FltCareful diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index cd507b5546..6ab117fe6e 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -19,7 +19,7 @@ module SimplUtils ( mkBoringStop, mkLazyArgStop, mkRhsStop, contIsRhsOrArg, interestingCallContext, interestingArgContext, - interestingArg, isStrictBndr, mkArgInfo + interestingArg, mkArgInfo ) where #include "HsVersions.h" diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 2bc1aff8af..d4a050499f 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -359,7 +359,7 @@ simplNonRecX :: SimplEnv simplNonRecX env bndr new_rhs = do { (env, bndr') <- simplBinder env bndr ; completeNonRecX env NotTopLevel NonRecursive - (isStrictBndr bndr) bndr bndr' new_rhs } + (isStrictId bndr) bndr bndr' new_rhs } completeNonRecX :: SimplEnv -> TopLevelFlag -> RecFlag -> Bool @@ -842,7 +842,7 @@ simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont = do { tick (PreInlineUnconditionally bndr) ; simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont } - | isStrictBndr bndr + | isStrictId bndr = do { simplExprF (rhs_se `setFloats` env) rhs (StrictBind bndr bndrs body env cont) } |