[project @ 2001-06-13 17:13:15 by rrt]

[ghc-hetmet.git] / ghc / compiler / stranal / WorkWrap.lhs

diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs
index e556ead..639bfdb 100644 (file)
--- a/ghc/compiler/stranal/WorkWrap.lhs
+++ b/ghc/compiler/stranal/WorkWrap.lhs
@@ -9,19 +9,18 @@ module WorkWrap ( wwTopBinds, mkWrapper ) where
 #include "HsVersions.h"
 
 import CoreSyn
-import CoreUnfold      ( Unfolding, certainlyWillInline )
-import CoreLint                ( beginPass, endPass )
-import CoreUtils       ( exprType, exprEtaExpandArity )
-import MkId            ( mkWorkerId )
+import CoreUnfold      ( certainlyWillInline )
+import CoreLint                ( showPass, endPass )
+import CoreUtils       ( exprType )
 import Id              ( Id, idType, idStrictness, idArity, isOneShotLambda,
-                         setIdStrictness, idInlinePragma, 
+                         setIdStrictness, idInlinePragma, mkWorkerId,
                          setIdWorkerInfo, idCprInfo, setInlinePragma )
 import Type            ( Type, isNewType, splitForAllTys, splitFunTys )
 import IdInfo          ( mkStrictnessInfo, noStrictnessInfo, StrictnessInfo(..),
-                         CprInfo(..), exactArity, InlinePragInfo(..), isNeverInlinePrag,
+                         CprInfo(..), InlinePragInfo(..), isNeverInlinePrag,
                          WorkerInfo(..)
                        )
-import Demand           ( Demand, wwLazy )
+import Demand           ( Demand )
 import UniqSupply      ( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
 import CmdLineOpts
 import WwLib
@@ -63,16 +62,14 @@ wwTopBinds :: DynFlags
 
 wwTopBinds dflags us binds
   = do {
-       beginPass dflags "Worker Wrapper binds";
+       showPass dflags "Worker Wrapper binds";
 
        -- Create worker/wrappers, and mark binders with their
        -- "strictness info" [which encodes their worker/wrapper-ness]
        let { binds' = workersAndWrappers us binds };
 
        endPass dflags "Worker Wrapper binds" 
-               (dopt Opt_D_dump_worker_wrapper dflags || 
-                    dopt Opt_D_verbose_core2core dflags) 
-                binds'
+               Opt_D_dump_worker_wrapper binds'
     }
 \end{code}
 
@@ -191,12 +188,25 @@ tryWW non_rec fn_id rhs
   =    -- Don't split things that will never be inlined
     returnUs [ (fn_id, rhs) ]
 
-  | non_rec && not do_coerce_ww && certainlyWillInline fn_id
+  | non_rec && certainlyWillInline fn_id
        -- No point in worker/wrappering a function that is going to be
        -- INLINEd wholesale anyway.  If the strictness analyser is run
        -- twice, this test also prevents wrappers (which are INLINEd)
        -- from being re-done.
+       --      
+       -- It's very important to refrain from w/w-ing an INLINE function
+       -- If we do so by mistake we transform
+       --      f = __inline (\x -> E)
+       -- into
+       --      f = __inline (\x -> case x of (a,b) -> fw E)
+       --      fw = \ab -> (__inline (\x -> E)) (a,b)
+       -- and the original __inline now vanishes, so E is no longer
+       -- inside its __inline wrapper.  Death!  Disaster!
        --
+       -- OUT OF DATE NOTE:
+       --      [There used to be "&& not do_coerce_ww" in the above test.
+       --       No longer necessary because SimplUtils.tryEtaExpansion
+       --       now deals with coerces.]
        -- The do_coerce_ww test is so that
        -- a function with a coerce should w/w to get rid
        -- of the coerces, which can significantly improve its arity.
@@ -207,10 +217,9 @@ tryWW non_rec fn_id rhs
        --                   x:xs -> __coerce (IO [Int]) (\ s -> (# s, x:xs #)
        --                   []   -> lvl_sJ8
        --
-       --
-       -- OUT OF DATE NOTE, kept for info:
-       -- It's out of date because now wrappers look very cheap 
-       -- even when they are inlined.
+       -- OUT OF DATE NOTE:
+       --      [Out of date because the size calculation in CoreUnfold now
+       --       makes wrappers look very cheap even when they are inlined.]
        --   In this case we add an INLINE pragma to the RHS.  Why?
        --   Because consider
        --        f = \x -> g x x