X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprelude%2FPrelRules.lhs;h=f179955efdde294ac5f14b9c7057ecb94a07ea74;hb=22b39e40ba469e0ab46dd248ef5aaf46f8327940;hp=9cdddc9065738ba1b188eea3852412431346a84a;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 9cdddc9..f179955 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -20,7 +20,7 @@ module PrelRules ( primOpRules, builtinRules ) where
 #include "HsVersions.h"
 
 import CoreSyn
-import Id		( mkWildId, isPrimOpId_maybe )
+import Id		( mkWildId, idUnfolding )
 import Literal		( Literal(..), mkMachInt, mkMachWord
 			, literalType
 			, word2IntLit, int2WordLit
@@ -30,7 +30,7 @@ import Literal		( Literal(..), mkMachInt, mkMachWord
 			, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
 			, float2DoubleLit, double2FloatLit
 			)
-import PrimOp		( PrimOp(..), primOpOcc )
+import PrimOp		( PrimOp(..), primOpOcc, tagToEnumKey )
 import TysWiredIn	( boolTy, trueDataConId, falseDataConId )
 import TyCon		( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
 import DataCon		( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
@@ -38,22 +38,41 @@ import CoreUtils	( cheapEqExpr, exprIsConApp_maybe )
 import Type		( tyConAppTyCon, coreEqType )
 import OccName		( occNameFS )
 import PrelNames	( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey,
-			  eqStringName, unpackCStringIdKey )
+			  eqStringName, unpackCStringIdKey, inlineIdName )
 import Maybes		( orElse )
 import Name		( Name )
 import Outputable
 import FastString
 import StaticFlags      ( opt_SimplExcessPrecision )
 
-import DATA_BITS	( Bits(..) )
+import Data.Bits	( Bits(..) )
 #if __GLASGOW_HASKELL__ >= 500
-import DATA_WORD	( Word )
+import Data.Word	( Word )
 #else
-import DATA_WORD	( Word64 )
+import Data.Word	( Word64 )
 #endif
 \end{code}
 
 
+Note [Constant folding]
+~~~~~~~~~~~~~~~~~~~~~~~
+primOpRules generates the rewrite rules for each primop
+These rules do what is often called "constant folding"
+E.g. the rules for +# might say
+	     4 +# 5 = 9
+Well, of course you'd need a lot of rules if you did it 
+like that, so we use a BuiltinRule instead, so that we
+can match in any two literal values.  So the rule is really
+more like
+	     (Lit 4) +# (Lit y) = Lit (x+#y)
+where the (+#) on the rhs is done at compile time
+
+That is why these rules are built in here.  Other rules
+which don't need to be built in are in GHC.Base. For 
+example:
+	x +# 0 = x
+
+
 \begin{code}
 primOpRules :: PrimOp -> Name -> [CoreRule]
 primOpRules op op_name = primop_rule op
@@ -386,7 +405,7 @@ For dataToTag#, we can reduce if either
 
 \begin{code}
 dataToTagRule [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag]
-  | Just TagToEnumOp <- isPrimOpId_maybe tag_to_enum
+  | tag_to_enum `hasKey` tagToEnumKey
   , ty1 `coreEqType` ty2
   = Just tag	-- dataToTag (tagToEnum x)   ==>   x
 
@@ -409,10 +428,12 @@ builtinRules :: [CoreRule]
 -- Rules for non-primops that can't be expressed using a RULE pragma
 builtinRules
   = [ BuiltinRule FSLIT("AppendLitString") unpackCStringFoldrName match_append_lit,
-      BuiltinRule FSLIT("EqString") eqStringName match_eq_string
+      BuiltinRule FSLIT("EqString") eqStringName match_eq_string,
+      BuiltinRule FSLIT("Inline") inlineIdName match_inline
     ]
 
 
+---------------------------------------------------
 -- The rule is this:
 -- 	unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)  =  unpackFoldrCString# "foobaz" c n
 
@@ -434,6 +455,7 @@ match_append_lit [Type ty1,
 
 match_append_lit other = Nothing
 
+---------------------------------------------------
 -- The rule is this:
 -- 	eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
 
@@ -444,4 +466,16 @@ match_eq_string [Var unpk1 `App` Lit (MachStr s1),
   = Just (if s1 == s2 then trueVal else falseVal)
 
 match_eq_string other = Nothing
+
+
+---------------------------------------------------
+-- The rule is this:
+--	inline (f a b c) = <f's unfolding> a b c
+-- (if f has an unfolding)
+match_inline (e:args2)
+  | (Var f, args1) <- collectArgs e,
+    Just unf <- maybeUnfoldingTemplate (idUnfolding f)
+  = Just (mkApps (mkApps unf args1) args2)
+
+match_inline other = Nothing
 \end{code}