X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=b695c988c8874cdbcdd78483a7d77398a4701997;hb=8a2809c29de9f23eba7ca682b48390033a9d40f6;hp=2a2751e9e715b8eab6d95ebc84775e35cd0b7802;hpb=805edf6e400001f6e11b4721b285ecd51e0c2445;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 2a2751e..b695c98 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -1,7 +1,9 @@ % +% (c) The University of Glasgow 2006 % (c) The AQUA Project, Glasgow University, 1994-1998 % -\section[CoreUnfold]{Core-syntax unfoldings} + +Core-syntax unfoldings Unfoldings (which can travel across module boundaries) are in Core syntax (namely @CoreExpr@s). @@ -30,31 +32,24 @@ module CoreUnfold ( #include "HsVersions.h" -import StaticFlags ( opt_UF_CreationThreshold, opt_UF_UseThreshold, - opt_UF_FunAppDiscount, opt_UF_KeenessFactor, - opt_UF_DearOp, - ) -import DynFlags ( DynFlags, DynFlag(..), dopt ) +import StaticFlags +import DynFlags import CoreSyn import PprCore () -- Instances -import OccurAnal ( occurAnalyseExpr ) -import CoreUtils ( exprIsHNF, exprIsCheap, exprIsTrivial ) -import Id ( Id, idType, isId, - idUnfolding, globalIdDetails - ) -import DataCon ( isUnboxedTupleCon ) -import Literal ( litSize ) -import PrimOp ( primOpIsDupable, primOpOutOfLine ) -import IdInfo ( OccInfo(..), GlobalIdDetails(..) ) -import Type ( isUnLiftedType ) -import PrelNames ( hasKey, buildIdKey, augmentIdKey ) +import OccurAnal +import CoreUtils +import Id +import DataCon +import Literal +import PrimOp +import IdInfo +import Type +import PrelNames import Bag import FastTypes import Outputable -#if __GLASGOW_HASKELL__ >= 404 -import GLAEXTS ( Int# ) -#endif +import GHC.Exts ( Int# ) \end{code} @@ -273,7 +268,6 @@ sizeExpr bOMB_OUT_SIZE top_args expr -- The 1+ is a little discount for reduced allocation in the caller alts_size tot_size _ = tot_size --- gaw 2004 size_up (Case e _ _ alts) = nukeScrutDiscount (size_up e) `addSize` foldr (addSize . size_up_alt) sizeZero alts -- We don't charge for the case itself @@ -502,14 +496,13 @@ StrictAnal.addStrictnessInfoToTopId \begin{code} callSiteInline :: DynFlags -> Bool -- True <=> the Id can be inlined - -> OccInfo -> Id -- The Id -> [Bool] -- One for each value arg; True if it is interesting -> Bool -- True <=> continuation is interesting -> Maybe CoreExpr -- Unfolding, if any -callSiteInline dflags active_inline occ id arg_infos interesting_cont +callSiteInline dflags active_inline id arg_infos interesting_cont = case idUnfolding id of { NoUnfolding -> Nothing ; OtherCon cs -> Nothing ; @@ -531,11 +524,7 @@ callSiteInline dflags active_inline occ id arg_infos interesting_cont yes_or_no | not active_inline = False - | otherwise = case occ of - IAmDead -> pprTrace "callSiteInline: dead" (ppr id) False - IAmALoopBreaker False -> False -- Note [RulesOnly] in OccurAnal - --OneOcc in_lam _ _ -> (not in_lam || is_cheap) && consider_safe True - other -> is_cheap && consider_safe False + | otherwise = is_cheap && consider_safe False -- We consider even the once-in-one-branch -- occurrences, because they won't all have been -- caught by preInlineUnconditionally. In particular, @@ -596,7 +585,6 @@ callSiteInline dflags active_inline occ id arg_infos interesting_cont if dopt Opt_D_dump_inlinings dflags then pprTrace "Considering inlining" (ppr id <+> vcat [text "active:" <+> ppr active_inline, - text "occ info:" <+> ppr occ, text "arg infos" <+> ppr arg_infos, text "interesting continuation" <+> ppr interesting_cont, text "is value:" <+> ppr is_value,