the scrutinee of the case, and we can inline it.
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module SetLevels (
setLevels,
idSpecialisation, idWorkerInfo, setIdInfo
)
import IdInfo ( workerExists, vanillaIdInfo, isEmptySpecInfo )
-import Var ( Var )
+import Var
import VarSet
import VarEnv
import Name ( getOccName )
context @Level 0 0@.
-InlineCtxt
-~~~~~~~~~~
+Note [FloatOut inside INLINE]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@InlineCtxt@ very similar to @Level 0 0@, but is used for one purpose:
to say "don't float anything out of here". That's exactly what we
want for the body of an INLINE, where we don't want to float anything
measured the effect on nofib of changing OLD CODE to 'True', and got
zeros everywhere, but a 4% win for 'puzzle'. Very small 0.5% loss for
'cse'; turns out to be because our arity analysis isn't good enough
-yet (mentioned in Simon-nofib-notes.
+yet (mentioned in Simon-nofib-notes).
OLD comment was:
Even if it escapes a value lambda, we only
-- Find the variables in fvs, free vars of the target expresion,
-- whose level is greater than the destination level
-- These are the ones we are going to abstract out
-abstractVars dest_lvl env fvs
- = uniq (sortLe le [var | fv <- varSetElems fvs, var <- absVarsOf dest_lvl env fv])
+abstractVars dest_lvl (_, lvl_env, _, id_env) fvs
+ = map zap $ uniq $ sortLe le
+ [var | fv <- varSetElems fvs
+ , var <- absVarsOf id_env fv
+ , abstract_me var]
where
- -- Sort the variables so we don't get
- -- mixed-up tyvars and Ids; it's just messy
- v1 `le` v2 = case (isId v1, isId v2) of
- (True, False) -> False
- (False, True) -> True
+ -- Sort the variables so the true type variables come first;
+ -- the tyvars scope over Ids and coercion vars
+ v1 `le` v2 = case (is_tv v1, is_tv v2) of
+ (True, False) -> True
+ (False, True) -> False
other -> v1 <= v2 -- Same family
+ is_tv v = isTyVar v && not (isCoVar v)
+
uniq :: [Var] -> [Var]
-- Remove adjacent duplicates; the sort will have brought them together
uniq (v1:v2:vs) | v1 == v2 = uniq (v2:vs)
| otherwise = v1 : uniq (v2:vs)
uniq vs = vs
-absVarsOf :: Level -> LevelEnv -> Var -> [Var]
- -- If f is free in the expression, and f maps to poly_f a b c in the
- -- current substitution, then we must report a b c as candidate type
- -- variables
-absVarsOf dest_lvl (_, lvl_env, _, id_env) v
- | isId v
- = [zap av2 | av1 <- lookup_avs v, av2 <- add_tyvars av1, abstract_me av2]
-
- | otherwise
- = if abstract_me v then [v] else []
-
- where
abstract_me v = case lookupVarEnv lvl_env v of
Just lvl -> dest_lvl `ltLvl` lvl
Nothing -> False
- lookup_avs v = case lookupVarEnv id_env v of
- Just (abs_vars, _) -> abs_vars
- Nothing -> [v]
-
- add_tyvars v = v : varSetElems (varTypeTyVars v)
-
-- We are going to lambda-abstract, so nuke any IdInfo,
-- and add the tyvars of the Id (if necessary)
zap v | isId v = WARN( workerExists (idWorkerInfo v) ||
text "absVarsOf: discarding info on" <+> ppr v )
setIdInfo v vanillaIdInfo
| otherwise = v
+
+absVarsOf :: IdEnv ([Var], LevelledExpr) -> Var -> [Var]
+ -- If f is free in the expression, and f maps to poly_f a b c in the
+ -- current substitution, then we must report a b c as candidate type
+ -- variables
+ --
+ -- Also, if x::a is an abstracted variable, then so is a; that is,
+ -- we must look in x's type
+ -- And similarly if x is a coercion variable.
+absVarsOf id_env v
+ | isId v = [av2 | av1 <- lookup_avs v
+ , av2 <- add_tyvars av1]
+ | isCoVar v = add_tyvars v
+ | otherwise = [v]
+
+ where
+ lookup_avs v = case lookupVarEnv id_env v of
+ Just (abs_vars, _) -> abs_vars
+ Nothing -> [v]
+
+ add_tyvars v = v : varSetElems (varTypeTyVars v)
\end{code}
\begin{code}