import Name
import NameEnv
import OccurAnal ( occurAnalyseExpr )
+import Demand ( isBottomingSig )
import Module
-import LazyUniqFM
+import UniqFM
import UniqSupply
import Outputable
import ErrUtils
\begin{code}
tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
-tcUnfolding name _ _ (IfCoreUnfold if_expr)
+tcUnfolding name _ info (IfCoreUnfold if_expr)
= do { mb_expr <- tcPragExpr name if_expr
; return (case mb_expr of
Nothing -> NoUnfolding
- Just expr -> mkTopUnfolding expr) }
+ Just expr -> mkTopUnfolding is_bottoming expr) }
+ where
+ -- Strictness should occur before unfolding!
+ is_bottoming = case strictnessInfo info of
+ Just sig -> isBottomingSig sig
+ Nothing -> False
-tcUnfolding name _ _ (IfInlineRule arity sat if_expr)
+tcUnfolding name _ _ (IfCompulsory if_expr)
= do { mb_expr <- tcPragExpr name if_expr
; return (case mb_expr of
Nothing -> NoUnfolding
- Just expr -> mkInlineRule inl_info expr arity) }
- where
- inl_info | sat = InlSat
- | otherwise = InlUnSat
+ Just expr -> mkCompulsoryUnfolding expr) }
+
+tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
+ = do { mb_expr <- tcPragExpr name if_expr
+ ; return (case mb_expr of
+ Nothing -> NoUnfolding
+ Just expr -> mkCoreUnfolding True InlineRule expr arity
+ (UnfWhen unsat_ok boring_ok))
+ }
tcUnfolding name ty info (IfWrapper arity wkr)
= do { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
(initUs_ us (mkWrapper ty strict_sig) wkr_id)
arity
- -- We are relying here on strictness info always appearing
- -- before worker info, fingers crossed ....
+ -- Again we rely here on strictness info always appearing
+ -- before unfolding
strict_sig = case strictnessInfo info of
Just sig -> sig
Nothing -> pprPanic "Worker info but no strictness for" (ppr wkr)