X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FcoreSyn%2FCoreUnfold.lhs;h=baf76c7225c1dc752add2c02e7be52d5b0456d02;hb=bc7bd6e3afa5d5d97d8eda26b79ac18cef0a0b42;hp=90463419c41e30bd70ed39842c9c35047afc921d;hpb=13a428caa18deb2805e307cbe7a99fa9f09c13a4;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 9046341..baf76c7 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -24,7 +24,6 @@ module CoreUnfold (
 
 	couldBeSmallEnoughToInline, 
 	certainlyWillInline, 
-	okToUnfoldInHiFile,
 
 	callSiteInline
     ) where
@@ -35,7 +34,7 @@ import CmdLineOpts	( opt_UF_CreationThreshold,
 			  opt_UF_UseThreshold,
 			  opt_UF_FunAppDiscount,
 		  	  opt_UF_KeenessFactor,
-			  opt_UF_DearOp, opt_UnfoldCasms,
+			  opt_UF_DearOp,
 			  DynFlags, DynFlag(..), dopt
 			)
 import CoreSyn
@@ -43,22 +42,21 @@ import PprCore		( pprCoreExpr )
 import OccurAnal	( occurAnalyseGlobalExpr )
 import CoreUtils	( exprIsValue, exprIsCheap, exprIsTrivial )
 import Id		( Id, idType, isId,
-			  idUnfolding,
-			  isFCallId_maybe, globalIdDetails
+			  idUnfolding, globalIdDetails
 			)
 import DataCon		( isUnboxedTupleCon )
-import Literal		( isLitLitLit, litSize )
+import Literal		( litSize )
 import PrimOp		( primOpIsDupable, primOpOutOfLine )
-import ForeignCall	( okToExposeFCall )
 import IdInfo		( OccInfo(..), GlobalIdDetails(..) )
 import Type		( isUnLiftedType )
 import PrelNames	( hasKey, buildIdKey, augmentIdKey )
 import Bag
 import FastTypes
 import Outputable
+import Util
 
 #if __GLASGOW_HASKELL__ >= 404
-import GlaExts		( fromInt, Int# )
+import GLAEXTS		( Int# )
 #endif
 \end{code}
 
@@ -138,7 +136,7 @@ calcUnfoldingGuidance bOMB_OUT_SIZE expr
 	| not inline -> UnfoldNever
 		-- A big function with an INLINE pragma must
 		-- have an UnfoldIfGoodArgs guidance
-	| inline     -> UnfoldIfGoodArgs n_val_binders
+	| otherwise  -> UnfoldIfGoodArgs n_val_binders
 					 (map (const 0) val_binders)
 					 max_inline_size 0
 
@@ -297,7 +295,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr
       | fun `hasKey` augmentIdKey = augmentSize
       | otherwise 
       = case globalIdDetails fun of
-	  DataConId dc -> conSizeN dc (valArgCount args)
+	  DataConWorkId dc -> conSizeN dc (valArgCount args)
 
 	  FCallId fc   -> sizeN opt_UF_DearOp
 	  PrimOpId op  -> primOpSize op (valArgCount args)
@@ -466,36 +464,6 @@ certainlyWillInline other
   = False
 \end{code}
 
-@okToUnfoldInHifile@ is used when emitting unfolding info into an interface
-file to determine whether an unfolding candidate really should be unfolded.
-The predicate is needed to prevent @_casm_@s (+ lit-lits) from being emitted
-into interface files. 
-
-The reason for inlining expressions containing _casm_s into interface files
-is that these fragments of C are likely to mention functions/#defines that
-will be out-of-scope when inlined into another module. This is not an
-unfixable problem for the user (just need to -#include the approp. header
-file), but turning it off seems to the simplest thing to do.
-
-\begin{code}
-okToUnfoldInHiFile :: CoreExpr -> Bool
-okToUnfoldInHiFile e = opt_UnfoldCasms || go e
- where
-    -- Race over an expression looking for CCalls..
-    go (Var v)                = case isFCallId_maybe v of
-				  Just fcall -> okToExposeFCall fcall
-				  Nothing    -> True
-    go (Lit lit)	      = not (isLitLitLit lit)
-    go (App fun arg)          = go fun && go arg
-    go (Lam _ body)           = go body
-    go (Let binds body)       = and (map go (body :rhssOfBind binds))
-    go (Case scrut bndr alts) = and (map go (scrut:rhssOfAlts alts)) &&
-				not (any isLitLitLit [ lit | (LitAlt lit, _, _) <- alts ])
-    go (Note _ body)          = go body
-    go (Type _)		      = True
-\end{code}
-
-
 %************************************************************************
 %*									*
 \subsection{callSiteInline}
@@ -591,7 +559,7 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con
 			-- If (not in_lam) && one_br then PreInlineUnconditionally
 			-- should have caught it, shouldn't it?  Unless it's a top
 			-- level thing.
-	    not (null arg_infos) || interesting_cont
+	    notNull arg_infos || interesting_cont
 
 	  | otherwise
 	  = case guidance of
@@ -669,7 +637,7 @@ computeDiscount n_vals_wanted arg_discounts res_discount arg_infos result_used
 			-- Discount of 1 for each arg supplied, because the 
 			-- result replaces the call
     round (opt_UF_KeenessFactor * 
-	   fromInt (arg_discount + result_discount))
+	   fromIntegral (arg_discount + result_discount))
   where
     arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)