Make another parse error more informative

[ghc-hetmet.git] / compiler / simplCore / SimplUtils.lhs

diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 4a8ad54..fbee984 100644 (file)
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -697,6 +697,27 @@ let-float if you inline windowToViewport
 However, as usual for Gentle mode, do not inline things that are
 inactive in the intial stages.  See Note [Gentle mode].
 
 However, as usual for Gentle mode, do not inline things that are
 inactive in the intial stages.  See Note [Gentle mode].
 

+Note [InlineRule and preInlineUnconditionally]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Surprisingly, do not pre-inline-unconditionally Ids with INLINE pragmas!
+Example
+
+   {-# INLINE f #-}
+   f :: Eq a => a -> a
+   f x = ...
+   
+   fInt :: Int -> Int
+   fInt = f Int dEqInt
+
+   ...fInt...fInt...fInt...
+
+Here f occurs just once, in the RHS of f1. But if we inline it there
+we'll lose the opportunity to inline at each of fInt's call sites.
+The INLINE pragma will only inline when the application is saturated
+for exactly this reason; and we don't want PreInlineUnconditionally
+to second-guess it.  A live example is Trac #3736.
+    c.f. Note [InlineRule and postInlineUnconditionally]
+

 Note [Top-level botomming Ids]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Don't inline top-level Ids that are bottoming, even if they are used just
 Note [Top-level botomming Ids]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Don't inline top-level Ids that are bottoming, even if they are used just

@@ -707,6 +728,7 @@ Inlining them won't make the program run faster!
 preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
 preInlineUnconditionally env top_lvl bndr rhs
   | not active                                      = False
 preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
 preInlineUnconditionally env top_lvl bndr rhs
   | not active                                      = False

+  | isStableUnfolding (idUnfolding bndr)     = False    -- Note [InlineRule and preInlineUnconditionally]

   | isTopLevel top_lvl && isBottomingId bndr = False   -- Note [Top-level bottoming Ids]
   | opt_SimplNoPreInlining                   = False
   | otherwise = case idOccInfo bndr of
   | isTopLevel top_lvl && isBottomingId bndr = False   -- Note [Top-level bottoming Ids]
   | opt_SimplNoPreInlining                   = False
   | otherwise = case idOccInfo bndr of

@@ -971,6 +993,8 @@ Then there's a danger we'll optimise to
 and now postInlineUnconditionally, losing the InlineRule on f.  Now f'
 won't inline because 'e' is too big.
 
 and now postInlineUnconditionally, losing the InlineRule on f.  Now f'
 won't inline because 'e' is too big.
 

+    c.f. Note [InlineRule and preInlineUnconditionally]
+

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -986,7 +1010,7 @@ mkLam :: SimplEnv -> [OutBndr] -> OutExpr -> SimplM OutExpr
 
 mkLam _b [] body 
   = return body
 
 mkLam _b [] body 
   = return body

-mkLam env bndrs body
+mkLam _env bndrs body

   = do { dflags <- getDOptsSmpl
        ; mkLam' dflags bndrs body }
   where
   = do { dflags <- getDOptsSmpl
        ; mkLam' dflags bndrs body }
   where

@@ -1007,9 +1031,7 @@ mkLam env bndrs body
           ; return etad_lam }
 
       | dopt Opt_DoLambdaEtaExpansion dflags,
           ; return etad_lam }
 
       | dopt Opt_DoLambdaEtaExpansion dflags,

-        not (inGentleMode env),              -- In gentle mode don't eta-expansion
-       any isRuntimeVar bndrs        -- because it can clutter up the code
-                                     -- with casts etc that may not be removed
+       not (all isTyVar bndrs) -- Don't eta expand type abstractions

       = do { let body' = tryEtaExpansion dflags body
           ; return (mkLams bndrs body') }
    
       = do { let body' = tryEtaExpansion dflags body
           ; return (mkLams bndrs body') }