Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/af5fa14d6fc288ab0b80ef32f3bad94591f5a818 >--------------------------------------------------------------- commit af5fa14d6fc288ab0b80ef32f3bad94591f5a818 Author: Simon Marlow <[email protected]> Date: Tue Jun 28 20:16:16 2011 +0100 Add a builtin rule for seq# when its argument is a manifest head-normal-form, and similarly for spark#. >--------------------------------------------------------------- compiler/prelude/PrelRules.lhs | 30 +++++++++++++++++++++++++++--- 1 files changed, 27 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index 93cc576..e9401d4 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -24,9 +24,10 @@ import Id import Literal import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn +import TysPrim import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon ) import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG ) -import CoreUtils ( cheapEqExpr ) +import CoreUtils ( cheapEqExpr, exprIsHNF ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -37,6 +38,7 @@ import Outputable import FastString import StaticFlags ( opt_SimplExcessPrecision ) import Constants +import BasicTypes import Data.Bits as Bits import Data.Int ( Int64 ) @@ -174,9 +176,10 @@ primOpRules op op_name = primop_rule op primop_rule WordEqOp = relop (==) primop_rule WordNeOp = relop (/=) - primop_rule _ = [] - + primop_rule SeqOp = mkBasicRule op_name 4 seqRule + primop_rule SparkOp = mkBasicRule op_name 4 sparkRule + primop_rule _ = [] \end{code} %************************************************************************ @@ -540,6 +543,27 @@ dataToTagRule _ _ = Nothing %************************************************************************ %* * +\subsection{Rules for seq# and spark#} +%* * +%************************************************************************ + +\begin{code} +-- seq# :: forall a s . a -> State# s -> (# State# s, a #) +seqRule :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr +seqRule _ [ty_a, Type ty_s, a, s] | exprIsHNF a + = Just (mkConApp (tupleCon Unboxed 2) + [Type (mkStatePrimTy ty_s), ty_a, s, a]) +seqRule _ _ = Nothing + +-- spark# :: forall a s . a -> State# s -> (# State# s, a #) +sparkRule :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr +sparkRule = seqRule -- reduce on HNF, just the same + -- XXX perhaps we shouldn't do this, because a spark eliminated by + -- this rule won't be counted as a dud at runtime? +\end{code} + +%************************************************************************ +%* * \subsection{Built in rules} %* * %************************************************************************ _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
