import Id ( isDataConWorkId, isOneShotBndr, setOneShotLambda,
idOccInfo, setIdOccInfo, isLocalId,
isExportedId, idArity, idHasRules,
- idType, idUnique, Id
+ idUnique, Id
)
import BasicTypes ( OccInfo(..), isOneOcc, InterestingCxt )
import VarSet
import VarEnv
-import Type ( isFunTy, dropForAlls )
import Maybes ( orElse )
import Digraph ( stronglyConnCompR, SCC(..) )
import PrelNames ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
-- where df is the exported dictionary. Then df makes a really
-- bad choice for loop breaker
- | not_fun_ty (idType bndr) = 3 -- Data types help with cases
+ | is_con_app rhs = 3 -- Data types help with cases
-- This used to have a lower score than inlineCandidate, but
-- it's *really* helpful if dictionaries get inlined fast,
-- so I'm experimenting with giving higher priority to data-typed things
-- we didn't stupidly choose d as the loop breaker.
-- But we won't because constructor args are marked "Many".
- not_fun_ty ty = not (isFunTy (dropForAlls ty))
+ -- Cheap and cheerful; the simplifer moves casts out of the way
+ -- The lambda case is important to spot x = /\a. C (f a)
+ -- which comes up when C is a dictionary constructor and
+ -- f is a default method.
+ -- Example: the instance for Show (ST s a) in GHC.ST
+ is_con_app (Var v) = isDataConWorkId v
+ is_con_app (App f _) = is_con_app f
+ is_con_app (Lam b e) | isTyVar b = is_con_app e
+ is_con_app (Note _ e) = is_con_app e
+ is_con_app other = False
makeLoopBreaker :: VarSet -- Binders of this group
-> UsageDetails -- Usage of this rhs (neglecting rules)
occAnal env (Cast expr co)
= case occAnal env expr of { (usage, expr') ->
- (usage, Cast expr' co)
+ (markRhsUds env True usage, Cast expr' co)
+ -- If we see let x = y `cast` co
+ -- then mark y as 'Many' so that we don't
+ -- immediately inline y again.
}
\end{code}
occAnalApp env (Var fun, args) is_rhs
= case args_stuff of { (args_uds, args') ->
let
- -- We mark the free vars of the argument of a constructor or PAP
- -- as "many", if it is the RHS of a let(rec).
- -- This means that nothing gets inlined into a constructor argument
- -- position, which is what we want. Typically those constructor
- -- arguments are just variables, or trivial expressions.
- --
- -- This is the *whole point* of the isRhsEnv predicate
- final_args_uds
- | isRhsEnv env,
- isDataConWorkId fun || valArgCount args < idArity fun
- = mapVarEnv markMany args_uds
- | otherwise = args_uds
+ final_args_uds = markRhsUds env is_pap args_uds
in
(fun_uds +++ final_args_uds, mkApps (Var fun) args') }
where
fun_uniq = idUnique fun
fun_uds = mkOneOcc env fun (valArgCount args > 0)
+ is_pap = isDataConWorkId fun || valArgCount args < idArity fun
-- Hack for build, fold, runST
args_stuff | fun_uniq == buildIdKey = appSpecial env 2 [True,True] args
in
(final_uds, mkApps fun' args') }}
+
+markRhsUds :: OccEnv -- Check if this is a RhsEnv
+ -> Bool -- and this is true
+ -> UsageDetails -- The do markMany on this
+ -> UsageDetails
+-- We mark the free vars of the argument of a constructor or PAP
+-- as "many", if it is the RHS of a let(rec).
+-- This means that nothing gets inlined into a constructor argument
+-- position, which is what we want. Typically those constructor
+-- arguments are just variables, or trivial expressions.
+--
+-- This is the *whole point* of the isRhsEnv predicate
+markRhsUds env is_pap arg_uds
+ | isRhsEnv env && is_pap = mapVarEnv markMany arg_uds
+ | otherwise = arg_uds
+
+
appSpecial :: OccEnv
-> Int -> CtxtTy -- Argument number, and context to use for it
-> [CoreExpr]