[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 f3a2ad0..081e039 100644 (file)
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ b/ghc/compiler/stranal/StrictAnal.lhs
@@ -19,6 +19,7 @@ import Id             ( idType, setIdStrictness,
                        )
 import IdInfo          ( mkStrictnessInfo )
 import CoreLint                ( beginPass, endPass )
+import Type            ( repType, splitFunTys )
 import ErrUtils                ( dumpIfSet )
 import SaAbsInt
 import SaLib
@@ -324,15 +325,24 @@ addStrictnessInfoToId
        -> Id                   -- Augmented with strictness
 
 addStrictnessInfoToId str_val abs_val binder body
-  = 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        = [idType id | id <- binders, isId id]
-                   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}