Commit 26caf834 authored by simonpj's avatar simonpj
Browse files

[project @ 1999-06-28 16:27:27 by simonpj]

Improve common sub-expression stuff
	- better hash function
	- add Const.isBoxedDataCon, and use it in CSE
	- don't CSE for nullary constructors
parent 960223bf
......@@ -7,7 +7,7 @@
module Const (
Con(..),
conType, conPrimRep,
conOkForApp, conOkForAlt, isWHNFCon, isDataCon,
conOkForApp, conOkForAlt, isWHNFCon, isDataCon, isBoxedDataCon,
conIsTrivial, conIsCheap, conIsDupable, conStrictness,
conOkForSpeculation, hashCon,
......@@ -31,7 +31,9 @@ import Name ( hashName )
import PrimOp ( PrimOp, primOpType, primOpIsDupable, primOpTag,
primOpIsCheap, primOpStrictness, primOpOkForSpeculation )
import PrimRep ( PrimRep(..) )
import DataCon ( DataCon, dataConName, dataConType, dataConTyCon, isNullaryDataCon, dataConRepStrictness )
import DataCon ( DataCon, dataConName, dataConType, dataConTyCon,
isNullaryDataCon, dataConRepStrictness, isUnboxedTupleCon
)
import TyCon ( isNewTyCon )
import Type ( Type, typePrimRep )
import PprType ( pprParendType )
......@@ -113,6 +115,9 @@ isWHNFCon (PrimOp _) = False
isDataCon (DataCon dc) = True
isDataCon other = False
isBoxedDataCon (DataCon dc) = not (isUnboxedTupleCon dc)
isBoxedDataCon other = False
-- conIsTrivial is true for constants we are unconditionally happy to duplicate
-- cf CoreUtils.exprIsTrivial
conIsTrivial (Literal lit) = not (isNoRepLit lit)
......
......@@ -18,6 +18,8 @@ module CoreUtils (
import {-# SOURCE #-} CoreUnfold ( isEvaldUnfolding )
import GlaExts -- For `xori`
import CoreSyn
import PprCore ( pprCoreExpr )
import Var ( IdOrTyVar, isId, isTyVar )
......@@ -400,19 +402,29 @@ eqExpr e1 e2
\begin{code}
hashExpr :: CoreExpr -> Int
hashExpr (Note _ e) = hashExpr e
hashExpr (Let (NonRec b r) e) = hashId b
hashExpr (Let (Rec ((b,r):_)) e) = hashId b
hashExpr (Case _ b _) = hashId b
hashExpr (App f e) = hashExpr f
hashExpr (Var v) = hashId v
hashExpr (Con con args) = hashArgs args (hashCon con)
hashExpr (Lam b _) = hashId b
hashExpr (Type t) = trace "hashExpr: type" 0 -- Shouldn't happen
hashArgs [] con = con
hashArgs (Type t : args) con = hashArgs args con
hashArgs (arg : args) con = hashExpr arg
hashExpr e = abs (hash_expr e)
-- Negative numbers kill UniqFM
hash_expr (Note _ e) = hash_expr e
hash_expr (Let (NonRec b r) e) = hashId b
hash_expr (Let (Rec ((b,r):_)) e) = hashId b
hash_expr (Case _ b _) = hashId b
hash_expr (App f e) = hash_expr f + fast_hash_expr e
hash_expr (Var v) = hashId v
hash_expr (Con con args) = foldr ((+) . fast_hash_expr) (hashCon con) args
hash_expr (Lam b _) = hashId b
hash_expr (Type t) = trace "hash_expr: type" 0 -- Shouldn't happen
fast_hash_expr (Var v) = hashId v
fast_hash_expr (Con con args) = fast_hash_args args con
fast_hash_expr (App f (Type _)) = fast_hash_expr f
fast_hash_expr (App f a) = fast_hash_expr a
fast_hash_expr (Lam b _) = hashId b
fast_hash_expr other = 0
fast_hash_args [] con = hashCon con
fast_hash_args (Type t : args) con = fast_hash_args args con
fast_hash_args (arg : args) con = fast_hash_expr arg
hashId :: Id -> Int
hashId id = hashName (idName id)
......
......@@ -13,8 +13,7 @@ module CSE (
import CmdLineOpts ( opt_D_dump_cse, opt_D_verbose_core2core )
import Id ( Id, idType )
import CoreUtils ( hashExpr, cheapEqExpr, exprIsBig )
import Const ( Con(..) )
import DataCon ( isUnboxedTupleCon )
import Const ( isBoxedDataCon )
import Type ( splitTyConApp_maybe )
import CoreSyn
import VarEnv
......@@ -131,13 +130,15 @@ cseAlts env bndr alts
other -> pprPanic "cseAlts" (ppr bndr)
cse_alt (con, args, rhs)
| ok_for_cse con = (con, args, cseExpr (extendCSEnv env bndr (Con con (arg_tys ++ (map varToCoreExpr args)))) rhs)
| otherwise = (con, args, cseExpr env rhs)
ok_for_cse DEFAULT = False
ok_for_cse (Literal l) = True
ok_for_cse (DataCon dc) = not (isUnboxedTupleCon dc)
-- Unboxed tuples aren't shared
| null args || not (isBoxedDataCon con) = (con, args, cseExpr env rhs)
-- Don't try CSE if there are no args; it just increases the number
-- of live vars. E.g.
-- case x of { True -> ....True.... }
-- Don't replace True by x!
-- Hence the 'null args', which also deal with literals and DEFAULT
-- And we can't CSE on unboxed tuples
| otherwise
= (con, args, cseExpr (extendCSEnv env bndr (Con con (arg_tys ++ (map varToCoreExpr args)))) rhs)
\end{code}
......
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