-- Properties of expressions
exprType, coreAltType,
exprIsDupable, exprIsTrivial, exprIsCheap,
- exprIsValue,exprOkForSpeculation, exprIsBig,
+ exprIsHNF,exprOkForSpeculation, exprIsBig,
exprIsConApp_maybe, exprIsBottom,
rhsIsStatic,
import VarSet ( unionVarSet )
import VarEnv
import Name ( hashName )
-import Packages ( isDllName, HomeModules )
+import Packages ( HomeModules )
+#if mingw32_TARGET_OS
+import Packages ( isDllName )
+#endif
import Literal ( hashLiteral, literalType, litIsDupable,
litIsTrivial, isZeroLit, Literal( MachLabel ) )
import DataCon ( DataCon, dataConRepArity, dataConArgTys,
splitTyConApp_maybe, coreEqType, funResultTy, applyTy
)
import TyCon ( tyConArity )
--- gaw 2004
import TysWiredIn ( boolTy, trueDataCon, falseDataCon )
import CostCentre ( CostCentre )
import BasicTypes ( Arity )
| n_val_args == 0 = True -- Just a type application of
-- a variable (f t1 t2 t3)
-- counts as WHNF
- | otherwise = case globalIdDetails id of
- DataConWorkId _ -> True
- RecordSelId _ _ -> True -- I'm experimenting with making record selection
- ClassOpId _ -> True -- look cheap, so we will substitute it inside a
- -- lambda. Particularly for dictionary field selection
-
- PrimOpId op -> primOpIsCheap op -- In principle we should worry about primops
- -- that return a type variable, since the result
- -- might be applied to something, but I'm not going
- -- to bother to check the number of args
- other -> n_val_args < idArity id
+ | otherwise
+ = case globalIdDetails id of
+ DataConWorkId _ -> True
+ RecordSelId _ _ -> n_val_args == 1 -- I'm experimenting with making record selection
+ ClassOpId _ -> n_val_args == 1 -- look cheap, so we will substitute it inside a
+ -- lambda. Particularly for dictionary field selection.
+ -- BUT: Take care with (sel d x)! The (sel d) might be cheap, but
+ -- there's no guarantee that (sel d x) will be too. Hence (n_val_args == 1)
+
+ PrimOpId op -> primOpIsCheap op -- In principle we should worry about primops
+ -- that return a type variable, since the result
+ -- might be applied to something, but I'm not going
+ -- to bother to check the number of args
+ other -> n_val_args < idArity id
\end{code}
exprOkForSpeculation returns True of an expression that it is
idAppIsBottom id n_val_args = appIsBottom (idNewStrictness id) n_val_args
\end{code}
-@exprIsValue@ returns true for expressions that are certainly *already*
+@exprIsHNF@ returns true for expressions that are certainly *already*
evaluated to *head* normal form. This is used to decide whether it's ok
to change
type must be ok-for-speculation (or trivial).
\begin{code}
-exprIsValue :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP
-exprIsValue (Var v) -- NB: There are no value args at this point
+exprIsHNF :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP
+exprIsHNF (Var v) -- NB: There are no value args at this point
= isDataConWorkId v -- Catches nullary constructors,
-- so that [] and () are values, for example
|| idArity v > 0 -- Catches (e.g.) primops that don't have unfoldings
-- A worry: what if an Id's unfolding is just itself:
-- then we could get an infinite loop...
-exprIsValue (Lit l) = True
-exprIsValue (Type ty) = True -- Types are honorary Values;
+exprIsHNF (Lit l) = True
+exprIsHNF (Type ty) = True -- Types are honorary Values;
-- we don't mind copying them
-exprIsValue (Lam b e) = isRuntimeVar b || exprIsValue e
-exprIsValue (Note _ e) = exprIsValue e
-exprIsValue (App e (Type _)) = exprIsValue e
-exprIsValue (App e a) = app_is_value e [a]
-exprIsValue other = False
+exprIsHNF (Lam b e) = isRuntimeVar b || exprIsHNF e
+exprIsHNF (Note _ e) = exprIsHNF e
+exprIsHNF (App e (Type _)) = exprIsHNF e
+exprIsHNF (App e a) = app_is_value e [a]
+exprIsHNF other = False
-- There is at least one value argument
app_is_value (Var fun) args
This should diverge! But if we eta-expand, it won't. Again, we ignore this
"problem", because being scrupulous would lose an important transformation for
many programs.
+
+
+4. Newtypes
+
+Non-recursive newtypes are transparent, and should not get in the way.
+We do (currently) eta-expand recursive newtypes too. So if we have, say
+
+ newtype T = MkT ([T] -> Int)
+
+Suppose we have
+ e = coerce T f
+where f has arity 1. Then: etaExpandArity e = 1;
+that is, etaExpandArity looks through the coerce.
+
+When we eta-expand e to arity 1: eta_expand 1 e T
+we want to get: coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
+
+HOWEVER, note that if you use coerce bogusly you can ge
+ coerce Int negate
+And since negate has arity 2, you might try to eta expand. But you can't
+decopose Int to a function type. Hence the final case in eta_expand.
-}
case splitRecNewType_maybe ty of {
Just ty' -> mkCoerce2 ty ty' (eta_expand n us (mkCoerce2 ty' ty expr) ty') ;
- Nothing -> pprTrace "Bad eta expand" (ppr n $$ ppr expr $$ ppr ty) expr
+ Nothing ->
+
+ -- We have an expression of arity > 0, but its type isn't a function
+ -- This *can* legitmately happen: e.g. coerce Int (\x. x)
+ -- Essentially the programmer is playing fast and loose with types
+ -- (Happy does this a lot). So we simply decline to eta-expand.
+ expr
}}}
\end{code}
-- t = /\a. (:) (case w a of ...) (Nil a) FALSE (redex)
--
--
--- This is a bit like CoreUtils.exprIsValue, with the following differences:
+-- This is a bit like CoreUtils.exprIsHNF, with the following differences:
-- a) scc "foo" (\x -> ...) is updatable (so we catch the right SCC)
--
-- b) (C x xs), where C is a contructors is updatable if the application is
projects / ghc-hetmet.git / blobdiff