import PrimOp ( PrimOp(..), primOpOcc )
import TysWiredIn ( trueDataConId, falseDataConId )
import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
-import DataCon ( dataConTag, dataConTyCon, dataConId, fIRST_TAG )
-import CoreUtils ( exprIsValue, cheapEqExpr, exprIsConApp_maybe )
+import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
+import CoreUtils ( cheapEqExpr, exprIsConApp_maybe )
import Type ( tyConAppTyCon, eqType )
import OccName ( occNameUserString)
import PrelNames ( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey,
eqStringName, unpackCStringIdKey )
import Maybes ( orElse )
import Name ( Name )
-import Bits ( Bits(..) )
+import Outputable
+import FastString
+import CmdLineOpts ( opt_SimplExcessPrecision )
+
+import DATA_BITS ( Bits(..) )
#if __GLASGOW_HASKELL__ >= 500
-import Word ( Word )
+import DATA_WORD ( Word )
#else
-import Word ( Word64 )
+import DATA_WORD ( Word64 )
#endif
-import Outputable
-import CmdLineOpts ( opt_SimplExcessPrecision )
\end{code}
primOpRules :: PrimOp -> [CoreRule]
primOpRules op = primop_rule op
where
- op_name = _PK_ (occNameUserString (primOpOcc op))
- op_name_case = op_name _APPEND_ SLIT("->case")
+ op_name = mkFastString (occNameUserString (primOpOcc op))
+ op_name_case = op_name `appendFS` FSLIT("->case")
-- A useful shorthand
one_rule rule_fn = [BuiltinRule op_name rule_fn]
-- ToDo: something for integer-shift ops?
-- NotOp
- primop_rule SeqOp = one_rule seqRule
primop_rule TagToEnumOp = one_rule tagToEnumRule
primop_rule DataToTagOp = one_rule dataToTagRule
%* *
%************************************************************************
-In the parallel world, we use _seq_ to control the order in which
-certain expressions will be evaluated. Operationally, the expression
-``_seq_ a b'' evaluates a and then evaluates b. We have an inlining
-for _seq_ which translates _seq_ to:
-
- _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y }
-
-Now, we know that the seq# primitive will never return 0#, but we
-don't let the simplifier know that. We also use a special error
-value, parError#, which is *not* a bottoming Id, so as far as the
-simplifier is concerned, we have to evaluate seq# a before we know
-whether or not y will be evaluated.
-
-If we didn't have the extra case, then after inlining the compiler might
-see:
- f p q = case seq# p of { _ -> p+q }
-
-If it sees that, it can see that f is strict in q, and hence it might
-evaluate q before p! The "0# ->" case prevents this happening.
-By having the parError# branch we make sure that anything in the
-other branch stays there!
-
-This is fine, but we'd like to get rid of the extraneous code. Hence,
-we *do* let the simplifier know that seq# is strict in its argument.
-As a result, we hope that `a' will be evaluated before seq# is called.
-At this point, we have a very special and magical simpification which
-says that ``seq# a'' can be immediately simplified to `1#' if we
-know that `a' is already evaluated.
-
-NB: If we ever do case-floating, we have an extra worry:
-
- case a of
- a' -> let b' = case seq# a of { True -> b; False -> parError# }
- in case b' of ...
-
- =>
-
- case a of
- a' -> let b' = case True of { True -> b; False -> parError# }
- in case b' of ...
-
- =>
-
- case a of
- a' -> let b' = b
- in case b' of ...
-
- =>
-
- case a of
- a' -> case b of ...
-
-The second case must never be floated outside of the first!
-
-\begin{code}
-seqRule [Type ty, arg] | exprIsValue arg = Just (mkIntVal 1)
-seqRule other = Nothing
-\end{code}
-
-
\begin{code}
tagToEnumRule [Type ty, Lit (MachInt i)]
= ASSERT( isEnumerationTyCon tycon )
[] -> Nothing -- Abstract type
(dc:rest) -> ASSERT( null rest )
- Just (Var (dataConId dc))
+ Just (Var (dataConWorkId dc))
where
correct_tag dc = (dataConTag dc - fIRST_TAG) == tag
tag = fromInteger i
builtinRules :: [(Name, CoreRule)]
-- Rules for non-primops that can't be expressed using a RULE pragma
builtinRules
- = [ (unpackCStringFoldrName, BuiltinRule SLIT("AppendLitString") match_append_lit),
- (eqStringName, BuiltinRule SLIT("EqString") match_eq_string)
+ = [ (unpackCStringFoldrName, BuiltinRule FSLIT("AppendLitString") match_append_lit),
+ (eqStringName, BuiltinRule FSLIT("EqString") match_eq_string)
]
c1 `cheapEqExpr` c2
= ASSERT( ty1 `eqType` ty2 )
Just (Var unpk `App` Type ty1
- `App` Lit (MachStr (s1 _APPEND_ s2))
+ `App` Lit (MachStr (s1 `appendFS` s2))
`App` c1
`App` n)