[commit: ghc] ghc-7.2: Add a builtin rule for seq# when its argument is a manifest (af5fa14)

[Ian Lynagh]

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 <marlowsd at gmail.com>
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}
 %*                                                                      *
 %************************************************************************