[project @ 2001-02-20 15:44:26 by simonpj]

Eta expansion wibbles
~~~~~~~~~~~~~~~~~~~~~
* Don't eta reduce, and do eta expand,
  data con workers and primops

  Reason: they don't have bindings, so they aren't really
  ordinary variables.

This is a bit of a swamp, provoked by moving CoreSat later,
something I'm beginning to wonder about...

Not are things settled yet -- I think some rules may
not fire that should because of constructor worker/wrapper
issues.  E.g when you have   foldr (:) [] xs = xs

diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index baae2ba..f0649d1 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -44,13 +44,13 @@ import Var          ( Var, isId, isTyVar )
 import VarSet
 import VarEnv
 import Name            ( hashName )
-import Literal         ( hashLiteral, literalType, litSize, litIsDupable )
+import Literal         ( hashLiteral, literalType, litIsDupable )
 import DataCon         ( DataCon, dataConRepArity )
 import PrimOp          ( primOpOkForSpeculation, primOpIsCheap, 
                          primOpIsDupable )
 import Id              ( Id, idType, idFlavour, idStrictness, idLBVarInfo, 
                          mkWildId, idArity, idName, idUnfolding, idInfo, 
-                         isDataConId_maybe, isPrimOpId_maybe, mkSysLocal
+                         isDataConId_maybe, isPrimOpId_maybe, mkSysLocal, hasNoBinding
                        )
 import IdInfo          ( LBVarInfo(..),  
                          IdFlavour(..),
@@ -258,7 +258,17 @@ mkIfThenElse guard then_expr else_expr
 
 \begin{code}
 exprIsTrivial (Var v)
-  | Just op <- isPrimOpId_maybe v      = primOpIsDupable op
+  | hasNoBinding v                    = idArity v == 0
+       -- WAS: | Just op <- isPrimOpId_maybe v      = primOpIsDupable op
+       -- The idea here is that a constructor worker, like $wJust, is
+       -- really short for (\x -> $wJust x), becuase $wJust has no binding.
+       -- So it should be treated like a lambda.
+       -- Ditto unsaturated primops.
+       -- This came up when dealing with eta expansion/reduction for
+       --      x = $wJust
+       -- Here we want to eta-expand.  This looks like an optimisation,
+       -- but it's important (albeit tiresome) that CoreSat doesn't increase 
+       -- anything's arity
   | otherwise                          = True
 exprIsTrivial (Type _)                = True
 exprIsTrivial (Lit lit)               = True

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index f9ff637..10268aa 100644 (file)
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.44 2001/02/20 11:04:42 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.45 2001/02/20 15:44:26 simonpj Exp $
 --
 -- Driver flags
 --
@@ -408,6 +408,7 @@ dynamic_flags = [
   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
+  ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )

diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index 36ac74b..42b0be1 100644 (file)
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.27 2001/02/20 11:04:42 simonmar Exp $
+-- $Id: DriverState.hs,v 1.28 2001/02/20 15:44:26 simonpj Exp $
 --
 -- Settings for the driver
 --
@@ -144,6 +144,10 @@ hsc_minusNoO_flags =
        [ 
        "-fignore-interface-pragmas",
        "-fomit-interface-pragmas",
+       "-fdo-lambda-eta-expansion",    -- This one is important for a tiresome reason:
+                                       -- we want to make sure that the bindings for data 
+                                       -- constructors are eta-expanded.  This is probably
+                                       -- a good thing anyway, but it seems fragile.
        "-flet-no-escape"
        ]
 

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 56466cb..c766c8f 100644 (file)
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -22,11 +22,10 @@ import SimplUtils   ( mkCase, tryRhsTyLam, tryEtaExpansion, findAlt,
                        )
 import Var             ( mkSysTyVar, tyVarKind )
 import VarEnv
-import VarSet          ( elemVarSet )
-import Id              ( Id, idType, idInfo, isDataConId,
+import Id              ( Id, idType, idInfo, isDataConId, hasNoBinding,
                          idUnfolding, setIdUnfolding, isExportedId, isDeadBinder,
                          idDemandInfo, setIdInfo,
-                         idOccInfo, setIdOccInfo,
+                         idOccInfo, setIdOccInfo, 
                          zapLamIdInfo, setOneShotLambda, 
                        )
 import IdInfo          ( OccInfo(..), isDeadOcc, isLoopBreaker,
@@ -40,7 +39,7 @@ import DataCon                ( dataConNumInstArgs, dataConRepStrictness,
                        )
 import CoreSyn
 import PprCore         ( pprParendExpr, pprCoreExpr )
-import CoreFVs         ( mustHaveLocalBinding, exprFreeVars )
+import CoreFVs         ( mustHaveLocalBinding )
 import CoreUnfold      ( mkOtherCon, mkUnfolding, otherCons,
                          callSiteInline
                        )
@@ -364,8 +363,12 @@ completeLam rev_bndrs body cont
        Nothing       -> rebuild (foldl (flip Lam) body' rev_bndrs) cont
   where
        -- We don't use CoreUtils.etaReduce, because we can be more
-       -- efficient here: (a) we already have the binders, (b) we can do
-       -- the triviality test before computing the free vars
+       -- efficient here:
+       --  (a) we already have the binders,
+       --  (b) we can do the triviality test before computing the free vars
+       --      [in fact I take the simple path and look for just a variable]
+       --  (c) we don't want to eta-reduce a data con worker or primop
+       --      because we only have to eta-expand them later when we saturate
     try_eta body | not opt_SimplDoEtaReduction = Nothing
                 | otherwise                   = go rev_bndrs body
 
@@ -373,8 +376,9 @@ completeLam rev_bndrs body cont
     go []       body          | ok_body body = Just body       -- Success!
     go _        _                           = Nothing          -- Failure!
 
-    ok_body body = exprIsTrivial body && not (any (`elemVarSet` exprFreeVars body) rev_bndrs)
-    ok_arg b arg = varToCoreExpr b `cheapEqExpr` arg
+    ok_body (Var v) = not (v `elem` rev_bndrs) && not (hasNoBinding v)
+    ok_body other   = False
+    ok_arg b arg    = varToCoreExpr b `cheapEqExpr` arg
 
 mkLamBndrZapper :: CoreExpr    -- Function
                -> SimplCont    -- The context