#include "HsVersions.h"
import CoreSyn
-import Id ( mkWildId, isPrimOpId_maybe )
+import Id ( mkWildId, isPrimOpId_maybe, idUnfolding )
import Literal ( Literal(..), mkMachInt, mkMachWord
, literalType
, word2IntLit, int2WordLit
, 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 )
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
\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
-- 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
match_append_lit other = Nothing
+---------------------------------------------------
-- The rule is this:
-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
= 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}