projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
49d454d
)
Use Id.isStrictId
author
simonpj@microsoft.com
<unknown>
Wed, 31 Jan 2007 15:06:16 +0000
(15:06 +0000)
committer
simonpj@microsoft.com
<unknown>
Wed, 31 Jan 2007 15:06:16 +0000
(15:06 +0000)
compiler/simplCore/LiberateCase.lhs
patch
|
blob
|
history
compiler/simplCore/SimplEnv.lhs
patch
|
blob
|
history
compiler/simplCore/SimplUtils.lhs
patch
|
blob
|
history
compiler/simplCore/Simplify.lhs
patch
|
blob
|
history
diff --git
a/compiler/simplCore/LiberateCase.lhs
b/compiler/simplCore/LiberateCase.lhs
index
31063d3
..
9b15734
100644
(file)
--- 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
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.
despite the cast. See mk_alt_env in the Case branch of libCase.
@@
-108,7
+108,6
@@
big.
Data types
~~~~~~~~~~
Data types
~~~~~~~~~~
-
The ``level'' of a binder tells how many
recursive defns lexically enclose the binding
A recursive defn "encloses" its RHS, not its
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
245f313
..
3832f54
100644
(file)
--- 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,
OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr,
InCoercion, OutCoercion,
- isStrictBndr,
-
-- The simplifier mode
setMode, getMode,
-- The simplifier mode
setMode, getMode,
@@
-92,13
+90,6
@@
type OutAlt = CoreAlt
type OutArg = CoreArg
\end{code}
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}
%************************************************************************
%* *
\subsubsection{The @SimplEnv@ type}
@@
-364,7
+355,7
@@
andFF FltLifted flt = flt
classifyFF :: CoreBind -> FloatFlag
classifyFF (Rec _) = FltLifted
classifyFF (NonRec bndr rhs)
classifyFF :: CoreBind -> FloatFlag
classifyFF (Rec _) = FltLifted
classifyFF (NonRec bndr rhs)
- | not (isStrictBndr bndr) = FltLifted
+ | not (isStrictId bndr) = FltLifted
| exprOkForSpeculation rhs = FltOkSpec
| otherwise = FltCareful
| exprOkForSpeculation rhs = FltOkSpec
| otherwise = FltCareful
diff --git
a/compiler/simplCore/SimplUtils.lhs
b/compiler/simplCore/SimplUtils.lhs
index
cd507b5
..
6ab117f
100644
(file)
--- a/
compiler/simplCore/SimplUtils.lhs
+++ b/
compiler/simplCore/SimplUtils.lhs
@@
-19,7
+19,7
@@
module SimplUtils (
mkBoringStop, mkLazyArgStop, mkRhsStop, contIsRhsOrArg,
interestingCallContext, interestingArgContext,
mkBoringStop, mkLazyArgStop, mkRhsStop, contIsRhsOrArg,
interestingCallContext, interestingArgContext,
- interestingArg, isStrictBndr, mkArgInfo
+ interestingArg, mkArgInfo
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
diff --git
a/compiler/simplCore/Simplify.lhs
b/compiler/simplCore/Simplify.lhs
index
2bc1aff
..
d4a0504
100644
(file)
--- 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
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
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 }
= 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) }
= do { simplExprF (rhs_se `setFloats` env) rhs
(StrictBind bndr bndrs body env cont) }