occAnal env (Cast expr co)
= case occAnal env expr of { (usage, expr') ->
- (markRhsUds env True usage, Cast expr' co)
+ (markManyIf (isRhsEnv env) 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.
occAnalApp env (Var fun, args)
= case args_stuff of { (args_uds, args') ->
let
- final_args_uds = markRhsUds env is_exp args_uds
+ final_args_uds = markManyIf (isRhsEnv env && is_exp) args_uds
+ -- 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
in
(fun_uds +++ final_args_uds, mkApps (Var fun) args') }
where
(final_uds, mkApps fun' args') }}
-markRhsUds :: OccEnv -- Check if this is a RhsEnv
- -> Bool -- and this is true
- -> UsageDetails -- The do markMany on this
+markManyIf :: Bool -- If this is true
+ -> UsageDetails -- Then 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
-
+markManyIf True uds = mapVarEnv markMany uds
+markManyIf False uds = uds
appSpecial :: OccEnv
-> Int -> CtxtTy -- Argument number, and context to use for it
| otherwise = PE env2 fvs2 -- don't extend
where
PE env1 fvs1 = trimProxyEnv pe [case_bndr]
- env2 = extendVarEnv_C add env1 scrut1 (scrut1, [(case_bndr,co)])
- add (x, cb_cos) _ = (x, (case_bndr,co):cb_cos)
+ env2 = extendVarEnv_Acc add single env1 scrut1 (case_bndr,co)
+ single cb_co = (scrut1, [cb_co])
+ add cb_co (x, cb_cos) = (x, cb_co:cb_cos)
fvs2 = fvs1 `unionVarSet` freeVarsCoI co
`extendVarSet` case_bndr
`extendVarSet` scrut1