- details = case rhs of
- Var v -> panic "Vars already dealt with"
- Lit lit | isNoRepLit lit -> LitForm lit
- | otherwise -> panic "non-noRep Lits already dealt with"
-
- Con con args -> ConForm con args
-
- other -> mkGenForm ok_to_dup occ_info
- (mkFormSummary (getIdStrictness out_id) rhs)
- template guidance
-
- -- Compute resulting unfold env
- new_unfold_env = case details of
- NoUnfoldingDetails -> unfold_env
- GenForm _ _ _ _ -> unfold_env2{-test: unfold_env1 -}
- other -> unfold_env1
-
- -- Add unfolding to unfold env
- unfold_env1 = grow_unfold_env unfold_env out_id details encl_cc
-
- -- Modify unfoldings of free vars of rhs, based on their
- -- occurrence info in the rhs [see notes above]
- unfold_env2 = foldr_unfold_env modify unfold_env1 (ufmToList fv_occ_info)
-
- modify :: (Unique, BinderInfo) -> IdEnv UnfoldItem -> IdEnv UnfoldItem
- modify (u, occ_info) env
- = case (lookupDirectlyUFM env u) of
- Nothing -> env -- ToDo: can this happen?
- Just xx -> addToUFM_Directly env u (modifyItem ok_to_dup occ_info xx)
-
- -- Compute unfolding guidance
- guidance = if simplIdWantsToBeINLINEd out_id env
- then UnfoldAlways
- else calcUnfoldingGuidance True{-sccs OK-} bOMB_OUT_SIZE rhs
-
- bOMB_OUT_SIZE = case (intSwitchSet chkr SimplUnfoldingCreationThreshold) of
- Nothing -> uNFOLDING_CREATION_THRESHOLD
- Just xx -> xx
-
- ok_to_dup = switchIsOn chkr SimplOkToDupCode
- || exprSmallEnoughToDup rhs
- -- [Andy] added, Jun 95
-
-{- Reinstated AJG Jun 95; This is needed
- --example that does not (currently) work
- --without this extention
-
- --let f = g x
- --in
- -- case <exp> of
- -- True -> h i f
- -- False -> f
- -- ==>
- -- case <exp> of
- -- True -> h i f
- -- False -> g x
--}
-{- OLD:
- Omitted SLPJ Feb 95; should, I claim, be unnecessary
- -- is_really_small looks for things like f a b c
- -- but making sure there are not *too* many arguments.
- -- (This is brought to you by *ANDY* Magic Constants, Inc.)
- is_really_small
- = case collectArgs new_rhs of
- (Var _, _, _, xs) -> length xs < 10
- _ -> False
--}
-\end{code}
-
-\begin{code}
-lookupUnfolding :: SimplEnv -> Id -> UnfoldingDetails
-
-lookupUnfolding (SimplEnv _ _ _ _ unfold_env) var
- | not (isLocallyDefined var) -- Imported, so look inside the id
- = getIdUnfolding var
-
- | otherwise -- Locally defined, so look in the envt.
- -- There'll be nothing inside the Id.
- = lookup_unfold_env unfold_env var
-\end{code}
-
-We need to remove any @GenForm@ bindings from the UnfoldEnv for
-the RHS of an Id which has an INLINE pragma.
-
-\begin{code}
-filterUnfoldEnvForInlines :: SimplEnv -> SimplEnv
-
-filterUnfoldEnvForInlines env@(SimplEnv chkr encl_cc ty_env id_env unfold_env)
- = SimplEnv chkr encl_cc ty_env id_env new_unfold_env
- where
- new_unfold_env = null_unfold_env
- -- This version is really simple. INLINEd things are going to
- -- be inlined wherever they are used, and then all the
- -- UnfoldEnv stuff will take effect. Meanwhile, there isn't
- -- much point in doing anything to the as-yet-un-INLINEd rhs.
-
- -- Andy disagrees! Example:
- -- all xs = foldr (&&) True xs
- -- any p = all . map p {-# INLINE any #-}
- --
- -- Problem: any won't get deforested, and so if it's exported and
- -- the importer doesn't use the inlining, (eg passes it as an arg)
- -- then we won't get deforestation at all.
- --
- -- So he'd like not to filter the unfold env at all. But that's a disaster:
- -- Suppose we have:
- --
- -- let f = \pq -> BIG
- -- in
- -- let g = \y -> f y y
- -- {-# INLINE g #-}
- -- in ...g...g...g...g...g...
- --
- -- Now, if that's the ONLY occurrence of f, it will be inlined inside g,
- -- and thence copied multiple times when g is inlined.
-\end{code}
-
-======================
-
-In @lookForConstructor@ we used (before Apr 94) to have a special case
-for nullary constructors:
-
-\begin{verbatim}
- = -- Don't re-use nullary constructors; it's a waste. Consider
- -- let
- -- a = leInt#! p q
- -- in
- -- case a of
- -- True -> ...
- -- False -> False
- --
- -- Here the False in the second case will get replace by "a", hardly
- -- a good idea
- Nothing
-\end{verbatim}
-
-but now we only do constructor re-use in let-bindings the special
-case isn't necessary any more.
-
-\begin{code}
-lookForConstructor (SimplEnv _ _ _ _ unfold_env) con args
- = lookup_conapp unfold_env con args