X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FTcIface.lhs;h=d8bd414edde3c6a2cb6f3c0e708e7b042cf36cb9;hb=215ce9f15215399ce30ae55c9521087847d78646;hp=c9c33dbde663e15492758ec1ec8823f7413de621;hpb=b84ba676034763b3082bbd9405794a4fde499d14;p=ghc-hetmet.git diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index c9c33db..d8bd414 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -48,7 +48,7 @@ import NameEnv import OccurAnal ( occurAnalyseExpr ) import Demand ( isBottomingSig ) import Module -import LazyUniqFM +import UniqFM import UniqSupply import Outputable import ErrUtils @@ -1015,11 +1015,19 @@ tcUnfolding name _ info (IfCoreUnfold if_expr) Just sig -> isBottomingSig sig Nothing -> False -tcUnfolding name _ _ (IfInlineRule arity unsat_ok if_expr) +tcUnfolding name _ _ (IfCompulsory if_expr) = do { mb_expr <- tcPragExpr name if_expr ; return (case mb_expr of Nothing -> NoUnfolding - Just expr -> mkInlineRule unsat_ok expr arity) } + 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)