summaryrefslogtreecommitdiff
path: root/ghc/compiler/specialise/Specialise.lhs
diff options
context:
space:
mode:
authorsof <unknown>2001-10-25 02:13:16 +0000
committersof <unknown>2001-10-25 02:13:16 +0000
commit9e93335020e64a811dbbb223e1727c76933a93ae (patch)
treeaa4607430cb048b7bf00cc9ab00620494b41f0e6 /ghc/compiler/specialise/Specialise.lhs
parentdccacbf9dd82d82657f4885a91d3deb57ce22f53 (diff)
downloadhaskell-9e93335020e64a811dbbb223e1727c76933a93ae.tar.gz
[project @ 2001-10-25 02:13:10 by sof]
- Pet peeve removal / code tidyup, replaced various sub-optimal uses of 'length' with something a bit better, i.e., replaced the following patterns * length as `cmpOp` length bs * length as `cmpOp` val -- incl. uses where val == 1 and val == 0 * {take,drop,splitAt} (length as) bs * length [ () | pat <- as ] with uses of misc Util functions. I'd be surprised if there's a noticeable reduction in running times as a result of these changes, but every little bit helps. [ The changes have been tested wrt testsuite/ - I'm seeing a couple of unexpected breakages coming from CorePrep, but I'm currently assuming that these are due to other recent changes. ] - compMan/CompManager.lhs: restored 4.08 compilability + some code cleanup. None of these changes are HEADworthy.
Diffstat (limited to 'ghc/compiler/specialise/Specialise.lhs')
-rw-r--r--ghc/compiler/specialise/Specialise.lhs17
1 files changed, 9 insertions, 8 deletions
diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index 0428772ca1..746814f968 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -40,7 +40,8 @@ import ErrUtils ( dumpIfSet_dyn )
import BasicTypes ( Activation( AlwaysActive ) )
import Bag
import List ( partition )
-import Util ( zipEqual, zipWithEqual, cmpList )
+import Util ( zipEqual, zipWithEqual, cmpList, lengthIs,
+ equalLength, lengthAtLeast )
import Outputable
@@ -785,8 +786,8 @@ specDefn :: Subst -- Subst to use for RHS
specDefn subst calls (fn, rhs)
-- The first case is the interesting one
- | n_tyvars == length rhs_tyvars -- Rhs of fn's defn has right number of big lambdas
- && n_dicts <= length rhs_bndrs -- and enough dict args
+ | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas
+ && rhs_bndrs `lengthAtLeast` n_dicts -- and enough dict args
&& not (null calls_for_me) -- And there are some calls to specialise
&& not (isDataConWrapId fn) -- And it's not a data con wrapper, which have
-- stupid overloading that simply discard the dictionary
@@ -848,7 +849,7 @@ specDefn subst calls (fn, rhs)
UsageDetails, -- Usage details from specialised body
CoreRule) -- Info for the Id's SpecEnv
spec_call (CallKey call_ts, (call_ds, call_fvs))
- = ASSERT( length call_ts == n_tyvars && length call_ds == n_dicts )
+ = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts )
-- Calls are only recorded for properly-saturated applications
-- Suppose f's defn is f = /\ a b c d -> \ d1 d2 -> rhs
@@ -910,8 +911,8 @@ specDefn subst calls (fn, rhs)
where
my_zipEqual doc xs ys
- | length xs /= length ys = pprPanic "my_zipEqual" (ppr xs $$ ppr ys $$ (ppr fn <+> ppr call_ts) $$ ppr rhs)
- | otherwise = zipEqual doc xs ys
+ | not (equalLength xs ys) = pprPanic "my_zipEqual" (ppr xs $$ ppr ys $$ (ppr fn <+> ppr call_ts) $$ ppr rhs)
+ | otherwise = zipEqual doc xs ys
dropInline :: CoreExpr -> (Bool, CoreExpr)
dropInline (Note InlineMe rhs) = (True, rhs)
@@ -1004,8 +1005,8 @@ callDetailsToList calls = [ (id,tys,dicts)
mkCallUDs subst f args
| null theta
- || length spec_tys /= n_tyvars
- || length dicts /= n_dicts
+ || not (spec_tys `lengthIs` n_tyvars)
+ || not ( dicts `lengthIs` n_dicts)
|| maybeToBool (lookupRule (\act -> True) (substInScope subst) f args)
-- There's already a rule covering this call. A typical case
-- is where there's an explicit user-provided rule. Then