summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2007-01-31 15:06:16 +0000
committersimonpj@microsoft.com <unknown>2007-01-31 15:06:16 +0000
commit96cb07b5940f98f35ac292e40d0129db5d3748ce (patch)
tree124775cea518fb18ce6160c40e5c9b7b5e78f37c /compiler
parent49d454d8f8f0e1a83369ec12f8aafc1dcf80aea9 (diff)
downloadhaskell-96cb07b5940f98f35ac292e40d0129db5d3748ce.tar.gz
Use Id.isStrictId
Diffstat (limited to 'compiler')
-rw-r--r--compiler/simplCore/LiberateCase.lhs3
-rw-r--r--compiler/simplCore/SimplEnv.lhs11
-rw-r--r--compiler/simplCore/SimplUtils.lhs2
-rw-r--r--compiler/simplCore/Simplify.lhs4
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) }