[project @ 1999-11-01 17:09:54 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..081e039 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,
@@ -19,11 +19,11 @@ import Id           ( idType, setIdStrictness,
                        )
 import IdInfo          ( mkStrictnessInfo )
 import CoreLint                ( beginPass, endPass )
+import Type            ( repType, splitFunTys )
 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 +75,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,12 +325,24 @@ addStrictnessInfoToId
        -> Id                   -- Augmented with strictness
 
 addStrictnessInfoToId str_val abs_val binder body
-  = case (collectTyAndValBinders body) of
-       (_, lambda_bounds, rhs) -> binder `setIdStrictness` 
-                                  mkStrictnessInfo strictness False
-               where
-                   tys        = map idType lambda_bounds
-                   strictness = findStrictness tys str_val abs_val
+  = binder `setIdStrictness` mkStrictnessInfo strictness
+  where
+    arg_tys = collect_arg_tys (idType binder)
+    strictness = findStrictness arg_tys str_val abs_val
+
+    collect_arg_tys ty
+       | null arg_tys = []
+       | otherwise    = arg_tys ++ collect_arg_tys res_ty
+       where
+         (arg_tys, res_ty) = splitFunTys (repType ty)
+    -- repType looks through for-alls and new-types.  And since we look on the
+    -- type info, we aren't confused by INLINE prags.
+    -- In particular, foldr is marked INLINE,
+    -- but we still want it to be strict in its third arg, so that
+    -- foldr k z (case e of p -> build g) 
+    -- gets transformed to
+    -- case e of p -> foldr k z (build g)
+    -- [foldr is only inlined late in compilation, after strictness analysis]
 \end{code}
 
 \begin{code}