[project @ 1999-06-08 16:46:44 by simonpj]

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

diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
index 3382bec..f3a2ad0 100644 (file)
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ b/ghc/compiler/stranal/StrictAnal.lhs
@@ -7,11 +7,11 @@ The original version(s) of all strictness-analyser code (except the
 Semantique analyser) was written by Andy Gill.
 
 \begin{code}
-module StrictAnal ( saWwTopBinds ) where
+module StrictAnal ( saBinds ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts     ( opt_D_dump_stranal, opt_D_simplifier_stats,  opt_D_verbose_core2core )
+import CmdLineOpts     ( opt_D_dump_stranal, opt_D_dump_simpl_stats,  opt_D_verbose_core2core )
 import CoreSyn
 import Id              ( idType, setIdStrictness,
                          getIdDemandInfo, setIdDemandInfo,
@@ -23,7 +23,6 @@ import ErrUtils               ( dumpIfSet )
 import SaAbsInt
 import SaLib
 import Demand          ( isStrict )
-import WorkWrap                -- "back-end" of strictness analyser
 import UniqSupply       ( UniqSupply )
 import Util            ( zipWith4Equal )
 import Outputable
@@ -75,29 +74,28 @@ Alas and alack.
 %*                                                                     *
 %************************************************************************
 
+@saBinds@ decorates bindings with strictness info.  A later 
+worker-wrapper pass can use this info to create wrappers and
+strict workers.
+
 \begin{code}
-saWwTopBinds :: UniqSupply
-            -> [CoreBind]
-            -> IO [CoreBind]
+saBinds ::[CoreBind]
+          -> IO [CoreBind]
 
-saWwTopBinds us binds
+saBinds binds
   = do {
        beginPass "Strictness analysis";
 
        -- Mark each binder with its strictness
 #ifndef OMIT_STRANAL_STATS
        let { (binds_w_strictness, sa_stats) = saTopBinds binds nullSaStats };
-       dumpIfSet opt_D_simplifier_stats "Strictness analysis statistics"
+       dumpIfSet opt_D_dump_simpl_stats "Strictness analysis statistics"
                  (pp_stats sa_stats);
 #else
        let { binds_w_strictness = saTopBindsBinds binds };
 #endif
 
-       -- Create worker/wrappers, and mark binders with their
-       -- "strictness info" [which encodes their worker/wrapper-ness]
-       let { binds' = workersAndWrappers us binds_w_strictness };
-
-       endPass "Strictness analysis" (opt_D_dump_stranal || opt_D_verbose_core2core) binds'
+       endPass "Strictness analysis" (opt_D_dump_stranal || opt_D_verbose_core2core) binds_w_strictness
     }
 \end{code}
 
@@ -326,11 +324,14 @@ addStrictnessInfoToId
        -> Id                   -- Augmented with strictness
 
 addStrictnessInfoToId str_val abs_val binder body
-  = case (collectTyAndValBinders body) of
-       (_, lambda_bounds, rhs) -> binder `setIdStrictness` 
-                                  mkStrictnessInfo strictness False
+  = case collectBinders body of
+       -- We could use 'collectBindersIgnoringNotes', but then the 
+       -- strictness info may have more items than the visible binders
+       -- used by WorkWrap.tryWW
+       (binders, rhs) -> binder `setIdStrictness` 
+                         mkStrictnessInfo strictness
                where
-                   tys        = map idType lambda_bounds
+                   tys        = [idType id | id <- binders, isId id]
                    strictness = findStrictness tys str_val abs_val
 \end{code}