[project @ 2001-02-26 15:06:57 by simonmar]

[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreSat.lhs

diff --git a/ghc/compiler/coreSyn/CoreSat.lhs b/ghc/compiler/coreSyn/CoreSat.lhs
index 62eda2e..9fdcc09 100644 (file)
--- a/ghc/compiler/coreSyn/CoreSat.lhs
+++ b/ghc/compiler/coreSyn/CoreSat.lhs
@@ -41,6 +41,7 @@ MAJOR CONSTRAINT:
 
        So we must not change the arity of any top-level function,
        because we've already fixed it and put it out into the interface file.
+       Nor must we change a value (e.g. constructor) into a thunk.
 
        It's ok to introduce extra bindings, which don't appear in the
        interface file.  We don't put arity info on these extra bindings,
@@ -385,10 +386,23 @@ mkNonRec :: Id  -> RhsDemand                      -- Lhs: id with demand
         -> OrdList FloatingBind -> CoreExpr    -- Rhs: let binds in body
         -> UniqSM (OrdList FloatingBind)
 mkNonRec bndr dem floats rhs
-  | exprIsValue rhs            -- Notably constructor applications
-  = ASSERT( allLazy floats )   -- The only floats we can get out of a value are eta expansions 
-                               -- e.g.  C $wJust ==> let s = \x -> $wJust x in C s
-                               -- Here we want to float the s binding.
+  | exprIsValue rhs && allLazy floats          -- Notably constructor applications
+  =    -- Why the test for allLazy? You might think that the only 
+       -- floats we can get out of a value are eta expansions 
+       -- e.g.  C $wJust ==> let s = \x -> $wJust x in C s
+       -- Here we want to float the s binding.
+       --
+       -- But if the programmer writes this:
+       --      f x = case x of { (a,b) -> \y -> a }
+       -- then the strictness analyser may say that f has strictness "S"
+       -- Later the eta expander will transform to
+       --      f x y = case x of { (a,b) -> a }
+       -- So now f has arity 2.  Now CoreSat may see
+       --      v = f E
+       -- so the E argument will turn into a FloatCase.  
+       -- Indeed we should end up with
+       --      v = case E of { r -> f r }
+       -- That is, we should not float, even though (f r) is a value
     returnUs (floats `snocOL` FloatLet (NonRec bndr rhs))
     
   |  isUnLiftedType bndr_rep_ty        || isStrictDem dem 
@@ -418,6 +432,13 @@ mkBinds binds body
 
 deLam :: CoreExpr -> UniqSM CoreExpr   
 -- Remove top level lambdas by let-bindinig
+
+deLam (Note n expr)
+  =    -- You can get things like
+       --      case e of { p -> coerce t (\s -> ...) }
+    deLam expr `thenUs` \ expr' ->
+    returnUs (Note n expr')
+
 deLam expr 
   | null bndrs = returnUs expr
   | otherwise  = case tryEta bndrs body of
@@ -427,6 +448,11 @@ deLam expr
   where
     (bndrs,body) = collectBinders expr
 
+-- Why try eta reduction?  Hasn't the simplifier already done eta?
+-- But the simplifier only eta reduces if that leaves something
+-- trivial (like f, or f Int).  But for deLam it would be enough to
+-- get to a partial application, like (map f).
+
 tryEta bndrs expr@(App _ _)
   | ok_to_eta_reduce f &&
     n_remaining >= 0 &&
@@ -496,3 +522,5 @@ safeDem, onceDem :: RhsDemand
 safeDem = RhsDemand False False  -- always safe to use this
 onceDem = RhsDemand False True   -- used at most once
 \end{code}
+
+