Commit 1703fe03 authored by simonpj's avatar simonpj
Browse files

[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
parent 48d9dabf
......@@ -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
......
{-# 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) )
......
-----------------------------------------------------------------------------
-- $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"
]
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment