import PprCore () -- Instances
import OccurAnal
import CoreSubst hiding( substTy )
+import CoreFVs ( exprFreeVars )
import CoreUtils
import Id
import DataCon
import Type
import Coercion
import PrelNames
+import VarEnv ( mkInScopeSet )
import Bag
import Util
import FastTypes
= CoreUnfolding { uf_tmpl = occurAnalyseExpr expr,
uf_arity = arity,
uf_is_top = top_lvl,
- uf_is_value = exprIsHNF expr,
- uf_is_cheap = exprIsCheap expr,
+ uf_is_value = exprIsHNF expr,
+ uf_is_conlike = exprIsConLike expr,
+ uf_is_cheap = exprIsCheap expr,
uf_expandable = exprIsExpandable expr,
uf_guidance = guidance }
Consider
f d = ...((*) d x y)...
... f (df d')...
-where df is con-like. Then we'd really like to inline so that the
+where df is con-like. Then we'd really like to inline 'f' so that the
rule for (*) (df d) can fire. To do this
a) we give a discount for being an argument of a class-op (eg (*) d)
b) we say that a con-like argument (eg (df d)) is interesting
-- data constructors here
| idArity v > n = ValueArg -- Catches (eg) primops with arity but no unfolding
| n > 0 = NonTrivArg -- Saturated or unknown call
- | evald_unfolding = ValueArg -- n==0; look for a value
+ | conlike_unfolding = ValueArg -- n==0; look for an interesting unfolding
+ -- See Note [Conlike is interesting]
| otherwise = TrivArg -- n==0, no useful unfolding
where
- evald_unfolding = isEvaldUnfolding (idUnfolding v)
+ conlike_unfolding = isConLikeUnfolding (idUnfolding v)
go (Type _) _ = TrivArg
go (App fn (Type _)) n = go fn n
let dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tyvars,
ppr arg_tys, ppr dc_args, ppr _dc_univ_args,
ppr ex_args, ppr val_args]
- ASSERT2( coreEqType from_ty (mkTyConApp dc_tc _dc_univ_args), dump_doc )
+ in
+ ASSERT2( coreEqType _from_ty (mkTyConApp dc_tc _dc_univ_args), dump_doc )
ASSERT2( all isTypeArg (ex_args ++ co_args), dump_doc )
ASSERT2( equalLength val_args arg_tys, dump_doc )
#endif
analyse _ _ = Nothing
-----------
+ in_scope = mkInScopeSet (exprFreeVars expr)
+
+ -----------
beta (Lam v body) pairs (arg : args)
| isTypeArg arg
= beta body ((v,arg):pairs) args
= Nothing
beta fun pairs args
- = case analyse (substExpr (mkOpenSubst pairs) fun) args of
+ = case analyse (substExpr subst fun) args of
Nothing -> -- pprTrace "Bale out! exprIsConApp_maybe" doc $
Nothing
Just ans -> -- pprTrace "Woo-hoo! exprIsConApp_maybe" doc $
Just ans
where
+ subst = mkOpenSubst in_scope pairs
-- doc = vcat [ppr fun, ppr expr, ppr pairs, ppr args]