tcIfaceRule :: IfaceRule -> IfL CoreRule
tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
- ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
+ ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
+ ifRuleAuto = auto })
= do { ~(bndrs', args', rhs') <-
-- Typecheck the payload lazily, in the hope it'll never be looked at
forkM (ptext (sLit "Rule") <+> ftext name) $
ru_bndrs = bndrs', ru_args = args',
ru_rhs = occurAnalyseExpr rhs',
ru_rough = mb_tcs,
+ ru_auto = auto,
ru_local = False }) } -- An imported RULE is never for a local Id
-- or, even if it is (module loop, perhaps)
-- we'll just leave it in the non-local set
; tcIfaceDataAlt con inst_tys arg_strs rhs }
tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
- = ASSERT( isTupleTyCon tycon )
+ = ASSERT2( isTupleTyCon tycon, ppr tycon )
do { let [data_con] = tyConDataCons tycon
; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
\begin{code}
tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
-tcUnfolding name _ info (IfCoreUnfold if_expr)
+tcUnfolding name _ info (IfCoreUnfold stable if_expr)
= do { mb_expr <- tcPragExpr name if_expr
+ ; let unf_src = if stable then InlineStable else InlineRhs
; return (case mb_expr of
- Nothing -> NoUnfolding
- Just expr -> mkTopUnfolding is_bottoming expr) }
+ Nothing -> NoUnfolding
+ Just expr -> mkUnfolding unf_src
+ True {- Top level -}
+ is_bottoming expr) }
where
-- Strictness should occur before unfolding!
is_bottoming = case strictnessInfo info of
= do { mb_expr <- tcPragExpr name if_expr
; return (case mb_expr of
Nothing -> NoUnfolding
- Just expr -> mkCoreUnfolding True InlineRule expr arity
+ Just expr -> mkCoreUnfolding True InlineStable expr arity
(UnfWhen unsat_ok boring_ok))
}
core_expr' <- tcIfaceExpr expr
-- Check for type consistency in the unfolding
- ifOptM Opt_DoCoreLinting $ do
+ ifDOptM Opt_DoCoreLinting $ do
in_scope <- get_in_scope_ids
case lintUnfolding noSrcLoc in_scope core_expr' of
Nothing -> return ()