Make the opt_UF_* static flags dynamic

I also removed the default values from the "Discounts and thresholds"
note: most of them were no longer up-to-date.

Along the way I added FloatSuffix to the argument parser, analogous to
IntSuffix.

compiler/basicTypes/MkId.lhs

@@ -429,13 +429,14 @@ at the outside.  When dealing with classes it's very convenient to
 recover the original type signature from the class op selector.
 
 \begin{code}
-mkDictSelId :: Bool	     -- True <=> don't include the unfolding
+mkDictSelId :: DynFlags
+            -> Bool	     -- True <=> don't include the unfolding
 			     -- Little point on imports without -O, because the
 			     -- dictionary itself won't be visible
  	    -> Name	     -- Name of one of the *value* selectors 
 	       		     -- (dictionary superclass or method)
             -> Class -> Id
-mkDictSelId no_unf name clas
+mkDictSelId dflags no_unf name clas
   = mkGlobalId (ClassOpId clas) name sel_ty info
   where
     sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
@@ -449,7 +450,7 @@ mkDictSelId no_unf name clas
                 `setArityInfo`      1
                 `setStrictnessInfo` Just strict_sig
                 `setUnfoldingInfo`  (if no_unf then noUnfolding
-	                             else mkImplicitUnfolding rhs)
+	                             else mkImplicitUnfolding dflags rhs)
 		   -- In module where class op is defined, we must add
 		   -- the unfolding, even though it'll never be inlined
 		   -- becuase we use that to generate a top-level binding

compiler/coreSyn/CoreUnfold.lhs

@@ -45,7 +45,6 @@ module CoreUnfold (
 
 #include "HsVersions.h"
 
-import StaticFlags
 import DynFlags
 import CoreSyn
 import PprCore		()	-- Instances
@@ -80,12 +79,13 @@ import Data.Maybe
 %************************************************************************
 
 \begin{code}
-mkTopUnfolding :: Bool -> CoreExpr -> Unfolding
-mkTopUnfolding = mkUnfolding InlineRhs True {- Top level -}
+mkTopUnfolding :: DynFlags -> Bool -> CoreExpr -> Unfolding
+mkTopUnfolding dflags = mkUnfolding dflags InlineRhs True {- Top level -}
 
-mkImplicitUnfolding :: CoreExpr -> Unfolding
+mkImplicitUnfolding :: DynFlags -> CoreExpr -> Unfolding
 -- For implicit Ids, do a tiny bit of optimising first
-mkImplicitUnfolding expr = mkTopUnfolding False (simpleOptExpr expr) 
+mkImplicitUnfolding dflags expr
+    = mkTopUnfolding dflags False (simpleOptExpr expr)
 
 -- Note [Top-level flag on inline rules]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -93,8 +93,8 @@ mkImplicitUnfolding expr = mkTopUnfolding False (simpleOptExpr expr)
 -- top-level flag to True.  It gets set more accurately by the simplifier
 -- Simplify.simplUnfolding.
 
-mkSimpleUnfolding :: CoreExpr -> Unfolding
-mkSimpleUnfolding = mkUnfolding InlineRhs False False
+mkSimpleUnfolding :: DynFlags -> CoreExpr -> Unfolding
+mkSimpleUnfolding dflags = mkUnfolding dflags InlineRhs False False
 
 mkDFunUnfolding :: Type -> [DFunArg CoreExpr] -> Unfolding
 mkDFunUnfolding dfun_ty ops 
@@ -130,9 +130,9 @@ mkInlineUnfolding mb_arity expr
               
     boring_ok = inlineBoringOk expr'
 
-mkInlinableUnfolding :: CoreExpr -> Unfolding
-mkInlinableUnfolding expr
-  = mkUnfolding InlineStable True is_bot expr'
+mkInlinableUnfolding :: DynFlags -> CoreExpr -> Unfolding
+mkInlinableUnfolding dflags expr
+  = mkUnfolding dflags InlineStable True is_bot expr'
   where
     expr' = simpleOptExpr expr
     is_bot = isJust (exprBotStrictness_maybe expr')
@@ -155,10 +155,11 @@ mkCoreUnfolding src top_lvl expr arity guidance
 		    uf_expandable   = exprIsExpandable expr,
 		    uf_guidance     = guidance }
 
-mkUnfolding :: UnfoldingSource -> Bool -> Bool -> CoreExpr -> Unfolding
+mkUnfolding :: DynFlags -> UnfoldingSource -> Bool -> Bool -> CoreExpr
+            -> Unfolding
 -- Calculates unfolding guidance
 -- Occurrence-analyses the expression before capturing it
-mkUnfolding src top_lvl is_bottoming expr
+mkUnfolding dflags src top_lvl is_bottoming expr
   | top_lvl && is_bottoming
   , not (exprIsTrivial expr)
   = NoUnfolding    -- See Note [Do not inline top-level bottoming functions]
@@ -173,7 +174,7 @@ mkUnfolding src top_lvl is_bottoming expr
 		    uf_is_work_free = exprIsWorkFree   expr,
 		    uf_guidance     = guidance }
   where
-    (arity, guidance) = calcUnfoldingGuidance expr
+    (arity, guidance) = calcUnfoldingGuidance dflags expr
         -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
 	-- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 \end{code}
@@ -232,18 +233,19 @@ inlineBoringOk e
     go _      _                		   = boringCxtNotOk
 
 calcUnfoldingGuidance
-	:: CoreExpr    	-- Expression to look at
-	-> (Arity, UnfoldingGuidance)
-calcUnfoldingGuidance expr
+        :: DynFlags
+        -> CoreExpr    -- Expression to look at
+        -> (Arity, UnfoldingGuidance)
+calcUnfoldingGuidance dflags expr
   = case collectBinders expr of { (bndrs, body) ->
     let
-        bOMB_OUT_SIZE = opt_UF_CreationThreshold 
+        bOMB_OUT_SIZE = ufCreationThreshold dflags
                -- Bomb out if size gets bigger than this
         val_bndrs   = filter isId bndrs
 	n_val_bndrs = length val_bndrs
 
     	guidance 
-          = case (sizeExpr (iUnbox bOMB_OUT_SIZE) val_bndrs body) of
+          = case sizeExpr dflags (iUnbox bOMB_OUT_SIZE) val_bndrs body of
       	      TooBig -> UnfNever
       	      SizeIs size cased_bndrs scrut_discount
       	        | uncondInline expr n_val_bndrs (iBox size)
@@ -375,7 +377,8 @@ uncondInline rhs arity size
 
 
 \begin{code}
-sizeExpr :: FastInt 	    -- Bomb out if it gets bigger than this
+sizeExpr :: DynFlags
+         -> FastInt 	    -- Bomb out if it gets bigger than this
 	 -> [Id]	    -- Arguments; we're interested in which of these
 			    -- get case'd
 	 -> CoreExpr
@@ -383,7 +386,7 @@ sizeExpr :: FastInt 	    -- Bomb out if it gets bigger than this
 
 -- Note [Computing the size of an expression]
 
-sizeExpr bOMB_OUT_SIZE top_args expr
+sizeExpr dflags bOMB_OUT_SIZE top_args expr
   = size_up expr
   where
     size_up (Cast e _) = size_up e
@@ -399,7 +402,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr
     size_up (App fun arg)      = size_up arg  `addSizeNSD`
                                  size_up_app fun [arg]
 
-    size_up (Lam b e) | isId b    = lamScrutDiscount (size_up e `addSizeN` 10)
+    size_up (Lam b e) | isId b    = lamScrutDiscount dflags (size_up e `addSizeN` 10)
 		      | otherwise = size_up e
 
     size_up (Let (NonRec binder rhs) body)
@@ -490,8 +493,8 @@ sizeExpr bOMB_OUT_SIZE top_args expr
            FCallId _        -> sizeN (10 * (1 + length val_args))
            DataConWorkId dc -> conSize    dc (length val_args)
            PrimOpId op      -> primOpSize op (length val_args)
-	   ClassOpId _ 	    -> classOpSize top_args val_args
-	   _     	    -> funSize top_args fun (length val_args)
+	   ClassOpId _ 	    -> classOpSize dflags top_args val_args
+	   _     	    -> funSize dflags top_args fun (length val_args)
 
     ------------ 
     size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10
@@ -540,11 +543,11 @@ litSize _other = 0    -- Must match size of nullary constructors
 	       	      -- Key point: if  x |-> 4, then x must inline unconditionally
 		      --     	    (eg via case binding)
 
-classOpSize :: [Id] -> [CoreExpr] -> ExprSize
+classOpSize :: DynFlags -> [Id] -> [CoreExpr] -> ExprSize
 -- See Note [Conlike is interesting]
-classOpSize _ [] 
+classOpSize _ _ []
   = sizeZero
-classOpSize top_args (arg1 : other_args)
+classOpSize dflags top_args (arg1 : other_args)
   = SizeIs (iUnbox size) arg_discount (_ILIT(0))
   where
     size = 20 + (10 * length other_args)
@@ -553,13 +556,13 @@ classOpSize top_args (arg1 : other_args)
     -- The actual discount is rather arbitrarily chosen
     arg_discount = case arg1 of
     		     Var dict | dict `elem` top_args 
-		     	      -> unitBag (dict, opt_UF_DictDiscount)
+		     	      -> unitBag (dict, ufDictDiscount dflags)
 		     _other   -> emptyBag
     		     
-funSize :: [Id] -> Id -> Int -> ExprSize
+funSize :: DynFlags -> [Id] -> Id -> Int -> ExprSize
 -- Size for functions that are not constructors or primops
 -- Note [Function applications]
-funSize top_args fun n_val_args
+funSize dflags top_args fun n_val_args
   | fun `hasKey` buildIdKey   = buildSize
   | fun `hasKey` augmentIdKey = augmentSize
   | otherwise = SizeIs (iUnbox size) arg_discount (iUnbox res_discount)
@@ -575,12 +578,12 @@ funSize top_args fun n_val_args
         --                  DISCOUNTS
         --  See Note [Function and non-function discounts]
     arg_discount | some_val_args && fun `elem` top_args
-    		 = unitBag (fun, opt_UF_FunAppDiscount)
+    		 = unitBag (fun, ufFunAppDiscount dflags)
 		 | otherwise = emptyBag
 	-- If the function is an argument and is applied
 	-- to some values, give it an arg-discount
 
-    res_discount | idArity fun > n_val_args = opt_UF_FunAppDiscount
+    res_discount | idArity fun > n_val_args = ufFunAppDiscount dflags
     		 | otherwise   	 	    = 0
         -- If the function is partially applied, show a result discount
 
@@ -691,9 +694,9 @@ augmentSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
 	-- e plus ys. The -2 accounts for the \cn 
 
 -- When we return a lambda, give a discount if it's used (applied)
-lamScrutDiscount :: ExprSize -> ExprSize
-lamScrutDiscount (SizeIs n vs _) = SizeIs n vs (iUnbox opt_UF_FunAppDiscount)
-lamScrutDiscount TooBig          = TooBig
+lamScrutDiscount :: DynFlags -> ExprSize -> ExprSize
+lamScrutDiscount dflags (SizeIs n vs _) = SizeIs n vs (iUnbox (ufFunAppDiscount dflags))
+lamScrutDiscount _      TooBig          = TooBig
 \end{code}
 
 Note [addAltSize result discounts]
@@ -707,31 +710,31 @@ binary sizes shrink significantly either.
 
 Note [Discounts and thresholds]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Constants for discounts and thesholds are defined in main/StaticFlags,
-all of form opt_UF_xxxx.   They are:
+Constants for discounts and thesholds are defined in main/DynFlags,
+all of form ufXxxx.   They are:
 
-opt_UF_CreationThreshold (45)
+ufCreationThreshold
      At a definition site, if the unfolding is bigger than this, we
      may discard it altogether
 
-opt_UF_UseThreshold (6)
+ufUseThreshold
      At a call site, if the unfolding, less discounts, is smaller than
      this, then it's small enough inline
 
-opt_UF_KeennessFactor (1.5)
+ufKeenessFactor
      Factor by which the discounts are multiplied before 
      subtracting from size
 
-opt_UF_DictDiscount (1)
+ufDictDiscount
      The discount for each occurrence of a dictionary argument
      as an argument of a class method.  Should be pretty small
      else big functions may get inlined
 
-opt_UF_FunAppDiscount (6)
+ufFunAppDiscount
      Discount for a function argument that is applied.  Quite
      large, because if we inline we avoid the higher-order call.
 
-opt_UF_DearOp (4)
+ufDearOp
      The size of a foreign call or not-dupable PrimOp
 
 
@@ -795,33 +798,33 @@ flaggery.  Just the same as smallEnoughToInline, except that it has no
 actual arguments.
 
 \begin{code}
-couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
-couldBeSmallEnoughToInline threshold rhs 
-  = case sizeExpr (iUnbox threshold) [] body of
+couldBeSmallEnoughToInline :: DynFlags -> Int -> CoreExpr -> Bool
+couldBeSmallEnoughToInline dflags threshold rhs 
+  = case sizeExpr dflags (iUnbox threshold) [] body of
        TooBig -> False
        _      -> True
   where
     (_, body) = collectBinders rhs
 
 ----------------
-smallEnoughToInline :: Unfolding -> Bool
-smallEnoughToInline (CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_size = size}})
-  = size <= opt_UF_UseThreshold
-smallEnoughToInline _
+smallEnoughToInline :: DynFlags -> Unfolding -> Bool
+smallEnoughToInline dflags (CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_size = size}})
+  = size <= ufUseThreshold dflags
+smallEnoughToInline _ _
   = False
 
 ----------------
-certainlyWillInline :: Unfolding -> Bool
+certainlyWillInline :: DynFlags -> Unfolding -> Bool
   -- Sees if the unfolding is pretty certain to inline	
-certainlyWillInline (CoreUnfolding { uf_arity = n_vals, uf_guidance = guidance })
+certainlyWillInline dflags (CoreUnfolding { uf_arity = n_vals, uf_guidance = guidance })
   = case guidance of
       UnfNever      -> False
       UnfWhen {}    -> True
       UnfIfGoodArgs { ug_size = size} 
                     -> n_vals > 0     -- See Note [certainlyWillInline: be caseful of thunks]
-                    && size - (10 * (n_vals +1)) <= opt_UF_UseThreshold
+                    && size - (10 * (n_vals +1)) <= ufUseThreshold dflags
 
-certainlyWillInline _
+certainlyWillInline _ _
   = False
 \end{code}
 
@@ -979,8 +982,8 @@ tryUnfolding dflags id lone_variable
                 , (text "discounted size =" <+> int discounted_size) )
     	     where
     	       discounted_size = size - discount
-    	       small_enough = discounted_size <= opt_UF_UseThreshold
-    	       discount = computeDiscount uf_arity arg_discounts 
+    	       small_enough = discounted_size <= ufUseThreshold dflags
+    	       discount = computeDiscount dflags uf_arity arg_discounts 
     	         		          res_discount arg_infos cont_info
 \end{code}
 
@@ -1172,8 +1175,9 @@ This kind of thing can occur if you have
 which Roman did.
 
 \begin{code}
-computeDiscount :: Int -> [Int] -> Int -> [ArgSummary] -> CallCtxt -> Int
-computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info
+computeDiscount :: DynFlags -> Int -> [Int] -> Int -> [ArgSummary] -> CallCtxt
+                -> Int
+computeDiscount dflags n_vals_wanted arg_discounts res_discount arg_infos cont_info
  	-- We multiple the raw discounts (args_discount and result_discount)
 	-- ty opt_UnfoldingKeenessFactor because the former have to do with
 	--  *size* whereas the discounts imply that there's some extra 
@@ -1187,7 +1191,7 @@ computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info
       	       -- Discount of (un-scaled) 1 for each arg supplied, 
    	       -- because the result replaces the call
 
-    + round (opt_UF_KeenessFactor * 
+    + round (ufKeenessFactor dflags *
 	     fromIntegral (arg_discount + res_discount'))
   where
     arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)

compiler/deSugar/DsBinds.lhs

@@ -101,23 +101,25 @@ dsLHsBind (L loc bind)
 dsHsBind :: HsBind Id -> DsM (OrdList (Id,CoreExpr))
 
 dsHsBind (VarBind { var_id = var, var_rhs = expr, var_inline = inline_regardless })
-  = do  { core_expr <- dsLExpr expr
+  = do  { dflags <- getDynFlags
+        ; core_expr <- dsLExpr expr
 
 	        -- Dictionary bindings are always VarBinds,
 	        -- so we only need do this here
         ; let var' | inline_regardless = var `setIdUnfolding` mkCompulsoryUnfolding core_expr
 	      	   | otherwise         = var
 
-        ; return (unitOL (makeCorePair var' False 0 core_expr)) }
+        ; return (unitOL (makeCorePair dflags var' False 0 core_expr)) }
 
 dsHsBind (FunBind { fun_id = L _ fun, fun_matches = matches
                   , fun_co_fn = co_fn, fun_tick = tick
                   , fun_infix = inf })
- = do	{ (args, body) <- matchWrapper (FunRhs (idName fun) inf) matches
+ = do	{ dflags <- getDynFlags
+        ; (args, body) <- matchWrapper (FunRhs (idName fun) inf) matches
         ; let body' = mkOptTickBox tick body
         ; rhs <- dsHsWrapper co_fn (mkLams args body')
         ; {- pprTrace "dsHsBind" (ppr fun <+> ppr (idInlinePragma fun)) $ -}
-           return (unitOL (makeCorePair fun False 0 rhs)) }
+           return (unitOL (makeCorePair dflags fun False 0 rhs)) }
 
 dsHsBind (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty
                   , pat_ticks = (rhs_tick, var_ticks) })
@@ -137,7 +139,8 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
                    , abs_ev_binds = ev_binds, abs_binds = binds })
   | ABE { abe_wrap = wrap, abe_poly = global
         , abe_mono = local, abe_prags = prags } <- export
-  = do  { bind_prs    <- ds_lhs_binds binds
+  = do  { dflags <- getDynFlags
+        ; bind_prs    <- ds_lhs_binds binds
 	; let	core_bind = Rec (fromOL bind_prs)
         ; ds_binds <- dsTcEvBinds ev_binds
         ; rhs <- dsHsWrapper wrap $  -- Usually the identity
@@ -149,7 +152,7 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
 	; (spec_binds, rules) <- dsSpecs rhs prags
 
 	; let   global'   = addIdSpecialisations global rules
-		main_bind = makeCorePair global' (isDefaultMethod prags)
+		main_bind = makeCorePair dflags global' (isDefaultMethod prags)
                                          (dictArity dicts) rhs 
     
 	; return (main_bind `consOL` spec_binds) }
@@ -158,8 +161,9 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
                    , abs_exports = exports, abs_ev_binds = ev_binds
                    , abs_binds = binds })
          -- See Note [Desugaring AbsBinds]
-  = do  { bind_prs    <- ds_lhs_binds binds
-        ; let core_bind = Rec [ makeCorePair (add_inline lcl_id) False 0 rhs
+  = do  { dflags <- getDynFlags
+        ; bind_prs    <- ds_lhs_binds binds
+        ; let core_bind = Rec [ makeCorePair dflags (add_inline lcl_id) False 0 rhs
                               | (lcl_id, rhs) <- fromOL bind_prs ]
 	      	-- Monomorphic recursion possible, hence Rec
 
@@ -207,8 +211,8 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
     add_inline lcl_id = lookupVarEnv inline_env lcl_id `orElse` lcl_id
 
 ------------------------
-makeCorePair :: Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr)
-makeCorePair gbl_id is_default_method dict_arity rhs
+makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr)
+makeCorePair dflags gbl_id is_default_method dict_arity rhs
   | is_default_method		      -- Default methods are *always* inlined
   = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs)
 
@@ -221,7 +225,7 @@ makeCorePair gbl_id is_default_method dict_arity rhs
 
   where
     inline_prag   = idInlinePragma gbl_id
-    inlinable_unf = mkInlinableUnfolding rhs
+    inlinable_unf = mkInlinableUnfolding dflags rhs
     inline_pair
        | Just arity <- inlinePragmaSat inline_prag
       	-- Add an Unfolding for an INLINE (but not for NOINLINE)
@@ -463,7 +467,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
        			(mkVarApps (Var spec_id) bndrs)
 
        ; spec_rhs <- dsHsWrapper spec_co poly_rhs
-       ; let spec_pair = makeCorePair spec_id False (dictArity bndrs) spec_rhs
+       ; let spec_pair = makeCorePair dflags spec_id False (dictArity bndrs) spec_rhs
 
        ; when (isInlinePragma id_inl && wopt Opt_WarnPointlessPragmas dflags)
               (warnDs (specOnInline poly_name))

compiler/iface/BuildTyCl.lhs

@@ -37,6 +37,7 @@ import TyCon
 import Type
 import Coercion
 
+import DynFlags
 import TcRnMonad
 import Util
 import Outputable
@@ -205,6 +206,8 @@ buildClass :: Bool		-- True <=> do not include unfoldings
 buildClass no_unf tycon_name tvs sc_theta fds at_items sig_stuff tc_isrec
   = fixM  $ \ rec_clas -> 	-- Only name generation inside loop
     do	{ traceIf (text "buildClass")
+        ; dflags <- getDynFlags
+
 	; datacon_name <- newImplicitBinder tycon_name mkClassDataConOcc
 		-- The class name is the 'parent' for this datacon, not its tycon,
 		-- because one should import the class to get the binding for 
@@ -217,7 +220,7 @@ buildClass no_unf tycon_name tvs sc_theta fds at_items sig_stuff tc_isrec
 	      -- Make selectors for the superclasses 
 	; sc_sel_names <- mapM  (newImplicitBinder tycon_name . mkSuperDictSelOcc) 
 				[1..length sc_theta]
-        ; let sc_sel_ids = [ mkDictSelId no_unf sc_name rec_clas 
+        ; let sc_sel_ids = [ mkDictSelId dflags no_unf sc_name rec_clas 
                            | sc_name <- sc_sel_names]
 	      -- We number off the Dict superclass selectors, 1, 2, 3 etc so that we 
 	      -- can construct names for the selectors. Thus
@@ -282,13 +285,14 @@ buildClass no_unf tycon_name tvs sc_theta fds at_items sig_stuff tc_isrec
   where
     mk_op_item :: Class -> TcMethInfo -> TcRnIf n m ClassOpItem
     mk_op_item rec_clas (op_name, dm_spec, _) 
-      = do { dm_info <- case dm_spec of
+      = do { dflags <- getDynFlags
+           ; dm_info <- case dm_spec of
                           NoDM      -> return NoDefMeth
                           GenericDM -> do { dm_name <- newImplicitBinder op_name mkGenDefMethodOcc
 			  	          ; return (GenDefMeth dm_name) }
                           VanillaDM -> do { dm_name <- newImplicitBinder op_name mkDefaultMethodOcc
 			  	          ; return (DefMeth dm_name) }
-           ; return (mkDictSelId no_unf op_name rec_clas, dm_info) }
+           ; return (mkDictSelId dflags no_unf op_name rec_clas, dm_info) }
 \end{code}
 
 Note [Class newtypes and equality predicates]

compiler/iface/TcIface.lhs

@@ -1198,11 +1198,12 @@ tcIdInfo ignore_prags name ty info
 \begin{code}
 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
 tcUnfolding name _ info (IfCoreUnfold stable if_expr)
-  = do  { mb_expr <- tcPragExpr name if_expr
+  = do  { dflags <- getDynFlags
+        ; mb_expr <- tcPragExpr name if_expr
         ; let unf_src = if stable then InlineStable else InlineRhs
         ; return (case mb_expr of
                     Nothing   -> NoUnfolding
-                    Just expr -> mkUnfolding unf_src
+                    Just expr -> mkUnfolding dflags unf_src
                                              True {- Top level -} 
                                              is_bottoming expr) }
   where

compiler/main/CmdLineParser.hs

@@ -48,6 +48,7 @@ data OptKind m                             -- Suppose the flag is -f
     | OptPrefix (String -> EwM m ())       -- -f or -farg (i.e. the arg is optional)
     | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn
     | IntSuffix (Int -> EwM m ())          -- -f or -f=n; pass n to fn
+    | FloatSuffix (Float -> EwM m ())      -- -f or -f=n; pass n to fn
     | PassFlag  (String -> EwM m ())       -- -f; pass "-f" fn
     | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire "-farg" to fn
     | PrefixPred    (String -> Bool) (String -> EwM m ())
@@ -188,6 +189,9 @@ processOneArg opt_kind rest arg args
         IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args)
                     | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
 
+        FloatSuffix f | Just n <- parseFloat rest_no_eq -> Right (f n, args)
+                      | otherwise -> Left ("malformed float argument in " ++ dash_arg)
+
         OptPrefix f       -> Right (f rest_no_eq, args)
         AnySuffix f       -> Right (f dash_arg, args)
         AnySuffixPred _ f -> Right (f dash_arg, args)
@@ -213,6 +217,7 @@ arg_ok (Prefix          _)  rest _   = notNull rest
 arg_ok (PrefixPred p    _)  rest _   = notNull rest && p (dropEq rest)
 arg_ok (OptIntSuffix    _)  _    _   = True
 arg_ok (IntSuffix       _)  _    _   = True
+arg_ok (FloatSuffix     _)  _    _   = True
 arg_ok (OptPrefix       _)  _    _   = True
 arg_ok (PassFlag        _)  rest _   = null rest
 arg_ok (AnySuffix       _)  _    _   = True
@@ -228,6 +233,11 @@ parseInt s = case reads s of
                  ((n,""):_) -> Just n
                  _          -> Nothing
 
+parseFloat :: String -> Maybe Float
+parseFloat s = case reads s of
+                   ((n,""):_) -> Just n
+                   _          -> Nothing
+
 -- | Discards a leading equals sign
 dropEq :: String -> String
 dropEq ('=' : s) = s

compiler/main/DynFlags.hs

@@ -646,6 +646,15 @@ data DynFlags = DynFlags {
   --     flattenExtensionFlags language extensions
   extensionFlags        :: IntSet,
 
+  -- Unfolding control
+  -- See Note [Discounts and thresholds] in CoreUnfold
+  ufCreationThreshold   :: Int,
+  ufUseThreshold        :: Int,
+  ufFunAppDiscount      :: Int,
+  ufDictDiscount        :: Int,
+  ufKeenessFactor       :: Float,
+  ufDearOp              :: Int,
+
   -- | MsgDoc output action: use "ErrUtils" instead of this if you can
   log_action            :: LogAction,
   flushOut              :: FlushOut,
@@ -1173,6 +1182,21 @@ defaultDynFlags mySettings =
         warnUnsafeOnLoc = noSrcSpan,
         extensions = [],
         extensionFlags = flattenExtensionFlags Nothing [],
+
+        -- The ufCreationThreshold threshold must be reasonably high to
+        -- take account of possible discounts.
+        -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to inline
+        -- into Csg.calc (The unfolding for sqr never makes it into the
+        -- interface file.)
+        ufCreationThreshold = 750,
+        ufUseThreshold      = 60,
+        ufFunAppDiscount    = 60,
+        -- Be fairly keen to inline a fuction if that means
+        -- we'll be able to pick the right method from a dictionary
+        ufDictDiscount      = 30,
+        ufKeenessFactor     = 1.5,
+        ufDearOp            = 40,
+
         log_action = defaultLogAction,
         flushOut = defaultFlushOut,
         flushErr = defaultFlushErr,
@@ -2027,6 +2051,12 @@ dynamic_flags = [
   , Flag "ffloat-all-lams"             (noArg (\d -> d{ floatLamArgs = Nothing }))
   , Flag "fhistory-size"               (intSuffix (\n d -> d{ historySize = n }))
 
+  , Flag "funfolding-creation-threshold" (intSuffix   (\n d -> d {ufCreationThreshold = n}))
+  , Flag "funfolding-use-threshold"      (intSuffix   (\n d -> d {ufUseThreshold = n}))
+  , Flag "funfolding-fun-discount"       (intSuffix   (\n d -> d {ufFunAppDiscount = n}))
+  , Flag "funfolding-dict-discount"      (intSuffix   (\n d -> d {ufDictDiscount = n}))
+  , Flag "funfolding-keeness-factor"     (floatSuffix (\n d -> d {ufKeenessFactor = n}))
+
         ------ Profiling ----------------------------------------------------
 
         -- OLD profiling flags
@@ -2712,6 +2742,9 @@ sepArg fn = SepArg (upd . fn)
 intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
 intSuffix fn = IntSuffix (\n -> upd (fn n))
 
+floatSuffix :: (Float -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+floatSuffix fn = FloatSuffix (\n -> upd (fn n))
+
 optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)
               -> OptKind (CmdLineP DynFlags)
 optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))

compiler/main/StaticFlagParser.hs

@@ -138,12 +138,7 @@ isStaticFlag f =
     ]
   || any (`isPrefixOf` f) [
     "fliberate-case-threshold",
-    "fmax-worker-args",
-    "funfolding-creation-threshold",
-    "funfolding-dict-threshold",
-    "funfolding-use-threshold",
-    "funfolding-fun-discount",
-    "funfolding-keeness-factor"
+    "fmax-worker-args"
      ]
 
 -----------------------------------------------------------------------------

compiler/main/StaticFlags.hs

@@ -52,14 +52,6 @@ module StaticFlags (
 	opt_MaxWorkerArgs,
         opt_NoFlatCache,
 
-	-- Unfolding control
-	opt_UF_CreationThreshold,
-	opt_UF_UseThreshold,
-	opt_UF_FunAppDiscount,
-	opt_UF_DictDiscount,
-	opt_UF_KeenessFactor,
-	opt_UF_DearOp,
-
     -- For the parser
     addOpt, removeOpt, v_opt_C_ready,
 
@@ -114,7 +106,6 @@ removeOpt f = do
 
 lookUp	       	 :: FastString -> Bool
 lookup_def_int   :: String -> Int -> Int
-lookup_def_float :: String -> Float -> Float
 lookup_str       :: String -> Maybe String
 
 -- holds the static opts while they're being collected, before
@@ -146,10 +137,12 @@ lookup_def_int sw def = case (lookup_str sw) of
 			    Nothing -> def		-- Use default
 		  	    Just xx -> try_read sw xx
 
+{-
+lookup_def_float :: String -> Float -> Float
 lookup_def_float sw def = case (lookup_str sw) of
 			    Nothing -> def		-- Use default
 		  	    Just xx -> try_read sw xx
-
+-}
 
 try_read :: Read a => String -> String -> a
 -- (try_read sw str) tries to read s; if it fails, it
@@ -265,29 +258,6 @@ opt_NoOptCoercion    	        = lookUp  (fsLit "-fno-opt-coercion")
 opt_NoFlatCache :: Bool
 opt_NoFlatCache    	        = lookUp  (fsLit "-fno-flat-cache")
 
--- Unfolding control
--- See Note [Discounts and thresholds] in CoreUnfold
-
-opt_UF_CreationThreshold, opt_UF_UseThreshold :: Int
-opt_UF_DearOp, opt_UF_FunAppDiscount, opt_UF_DictDiscount :: Int
-opt_UF_KeenessFactor :: Float
-
-opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (750::Int)
-  -- This threshold must be reasonably high to take 
-  -- account of possible discounts.  
-  -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to inline into Csg.calc
-  --      (The unfolding for sqr never makes it into the interface file.)
-
-opt_UF_UseThreshold      = lookup_def_int "-funfolding-use-threshold"      (60::Int)
-opt_UF_FunAppDiscount    = lookup_def_int "-funfolding-fun-discount"       (60::Int)
-
-opt_UF_DictDiscount      = lookup_def_int "-funfolding-dict-discount"      (30::Int)
-   -- Be fairly keen to inline a fuction if that means
-   -- we'll be able to pick the right method from a dictionary
-
-opt_UF_KeenessFactor	 = lookup_def_float "-funfolding-keeness-factor"   (1.5::Float)
-opt_UF_DearOp            = ( 40 :: Int)
-
 -----------------------------------------------------------------------------
 -- Tunneling our global variables into a new instance of the GHC library
 

compiler/main/TidyPgm.lhs

@@ -1074,14 +1074,14 @@ tidyTopBind dflags this_pkg mkIntegerId unfold_env (occ_env,subst1) (NonRec bndr
   where
     Just (name',show_unfold) = lookupVarEnv unfold_env bndr
     caf_info      = hasCafRefs dflags this_pkg (mkIntegerId, subst1) (idArity bndr) rhs
-    (bndr', rhs') = tidyTopPair show_unfold tidy_env2 caf_info name' (bndr, rhs)
+    (bndr', rhs') = tidyTopPair dflags show_unfold tidy_env2 caf_info name' (bndr, rhs)
     subst2        = extendVarEnv subst1 bndr bndr'
     tidy_env2     = (occ_env, subst2)
 
 tidyTopBind dflags this_pkg mkIntegerId unfold_env (occ_env,subst1) (Rec prs)
   = (tidy_env2, Rec prs')