X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;fp=compiler%2Fiface%2FMkIface.lhs;h=fd8fbdb5aeacb9f606a05b6e987f460228602ced;hp=68c6cf16a69191df5af9b89ba8363193be23e54d;hb=a51fe79ebcdcb8285573a18f12cade2101533419;hpb=0ccc12b6d176efe4a6d605864412deda75b62459 diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 68c6cf1..fd8fbdb 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1535,21 +1535,23 @@ toIfaceIdInfo id_info -------------------------- toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem -toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity - , uf_src = src, uf_guidance = guidance }) +toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity + , uf_src = src, uf_guidance = guidance }) = Just $ HsUnfold lb $ case src of - InlineRule {} + InlineStable -> case guidance of - UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs) - _other -> pprPanic "toIfUnfolding" (ppr unf) + UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok if_rhs + _other -> IfCoreUnfold True if_rhs InlineWrapper w -> IfWrapper arity (idName w) - InlineCompulsory -> IfCompulsory (toIfaceExpr rhs) - InlineRhs -> IfCoreUnfold (toIfaceExpr rhs) + InlineCompulsory -> IfCompulsory if_rhs + InlineRhs -> IfCoreUnfold False if_rhs -- Yes, even if guidance is UnfNever, expose the unfolding -- If we didn't want to expose the unfolding, TidyPgm would -- have stuck in NoUnfolding. For supercompilation we want -- to see that unfolding! + where + if_rhs = toIfaceExpr rhs toIfUnfolding lb (DFunUnfolding _ar _con ops) = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))