diff options
author | sof <unknown> | 2001-10-25 02:13:16 +0000 |
---|---|---|
committer | sof <unknown> | 2001-10-25 02:13:16 +0000 |
commit | 9e93335020e64a811dbbb223e1727c76933a93ae (patch) | |
tree | aa4607430cb048b7bf00cc9ab00620494b41f0e6 /ghc/compiler/specialise/Specialise.lhs | |
parent | dccacbf9dd82d82657f4885a91d3deb57ce22f53 (diff) | |
download | haskell-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.lhs | 17 |
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 |