ToDo:
check boundaries before folding, e.g. we can fold the Float addition
- (i1 + i2) only if it results in a valid Float.
+ (i1 + i2) only if it results in a valid Float.
\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
import MkCore
import Id
import Literal
-import PrimOp ( PrimOp(..), tagToEnumKey )
+import PrimOp ( PrimOp(..), tagToEnumKey )
import TysWiredIn
-import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
-import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
-import CoreUtils ( cheapEqExpr )
-import CoreUnfold ( exprIsConApp_maybe )
+import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
+import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
+import CoreUtils ( cheapEqExpr )
+import CoreUnfold ( exprIsConApp_maybe )
import Type
-import OccName ( occNameFS )
+import OccName ( occNameFS )
import PrelNames
-import Maybes ( orElse )
-import Name ( Name, nameOccName )
+import Maybes ( orElse )
+import Name ( Name, nameOccName )
import Outputable
import FastString
-import StaticFlags ( opt_SimplExcessPrecision )
+import StaticFlags ( opt_SimplExcessPrecision )
import Constants
import Data.Bits as Bits
-import Data.Word ( Word )
+import Data.Word ( Word )
\end{code}
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
+ 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)
+ (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
+which don't need to be built in are in GHC.Base. For
example:
- x +# 0 = x
+ x +# 0 = x
\begin{code}
primOpRules :: PrimOp -> Name -> [CoreRule]
primOpRules op op_name = primop_rule op
where
- -- A useful shorthand
+ -- A useful shorthand
one_lit = oneLit op_name
two_lits = twoLits op_name
relop cmp = two_lits (cmpOp (\ord -> ord `cmp` EQ))
- -- Cunning. cmpOp compares the values to give an Ordering.
- -- It applies its argument to that ordering value to turn
- -- the ordering into a boolean value. (`cmp` EQ) is just the job.
+ -- Cunning. cmpOp compares the values to give an Ordering.
+ -- It applies its argument to that ordering value to turn
+ -- the ordering into a boolean value. (`cmp` EQ) is just the job.
- -- ToDo: something for integer-shift ops?
- -- NotOp
+ -- ToDo: something for integer-shift ops?
+ -- NotOp
primop_rule TagToEnumOp = mkBasicRule op_name 2 tagToEnumRule
primop_rule DataToTagOp = mkBasicRule op_name 2 dataToTagRule
- -- Int operations
+ -- Int operations
primop_rule IntAddOp = two_lits (intOp2 (+))
primop_rule IntSubOp = two_lits (intOp2 (-))
primop_rule IntMulOp = two_lits (intOp2 (*))
primop_rule ISraOp = two_lits (intShiftOp2 Bits.shiftR)
primop_rule ISrlOp = two_lits (intShiftOp2 shiftRightLogical)
- -- Word operations
+ -- Word operations
primop_rule WordAddOp = two_lits (wordOp2 (+))
primop_rule WordSubOp = two_lits (wordOp2 (-))
primop_rule WordMulOp = two_lits (wordOp2 (*))
primop_rule SllOp = two_lits (wordShiftOp2 Bits.shiftL)
primop_rule SrlOp = two_lits (wordShiftOp2 shiftRightLogical)
- -- coercions
- primop_rule Word2IntOp = one_lit (litCoerce word2IntLit)
- primop_rule Int2WordOp = one_lit (litCoerce int2WordLit)
- primop_rule Narrow8IntOp = one_lit (litCoerce narrow8IntLit)
- primop_rule Narrow16IntOp = one_lit (litCoerce narrow16IntLit)
- primop_rule Narrow32IntOp = one_lit (litCoerce narrow32IntLit)
- primop_rule Narrow8WordOp = one_lit (litCoerce narrow8WordLit)
- primop_rule Narrow16WordOp = one_lit (litCoerce narrow16WordLit)
- primop_rule Narrow32WordOp = one_lit (litCoerce narrow32WordLit)
- primop_rule OrdOp = one_lit (litCoerce char2IntLit)
- primop_rule ChrOp = one_lit (predLitCoerce litFitsInChar int2CharLit)
- primop_rule Float2IntOp = one_lit (litCoerce float2IntLit)
- primop_rule Int2FloatOp = one_lit (litCoerce int2FloatLit)
- primop_rule Double2IntOp = one_lit (litCoerce double2IntLit)
- primop_rule Int2DoubleOp = one_lit (litCoerce int2DoubleLit)
- -- SUP: Not sure what the standard says about precision in the following 2 cases
- primop_rule Float2DoubleOp = one_lit (litCoerce float2DoubleLit)
- primop_rule Double2FloatOp = one_lit (litCoerce double2FloatLit)
-
- -- Float
+ -- coercions
+ primop_rule Word2IntOp = one_lit (litCoerce word2IntLit)
+ primop_rule Int2WordOp = one_lit (litCoerce int2WordLit)
+ primop_rule Narrow8IntOp = one_lit (litCoerce narrow8IntLit)
+ primop_rule Narrow16IntOp = one_lit (litCoerce narrow16IntLit)
+ primop_rule Narrow32IntOp = one_lit (litCoerce narrow32IntLit)
+ primop_rule Narrow8WordOp = one_lit (litCoerce narrow8WordLit)
+ primop_rule Narrow16WordOp = one_lit (litCoerce narrow16WordLit)
+ primop_rule Narrow32WordOp = one_lit (litCoerce narrow32WordLit)
+ primop_rule OrdOp = one_lit (litCoerce char2IntLit)
+ primop_rule ChrOp = one_lit (predLitCoerce litFitsInChar int2CharLit)
+ primop_rule Float2IntOp = one_lit (litCoerce float2IntLit)
+ primop_rule Int2FloatOp = one_lit (litCoerce int2FloatLit)
+ primop_rule Double2IntOp = one_lit (litCoerce double2IntLit)
+ primop_rule Int2DoubleOp = one_lit (litCoerce int2DoubleLit)
+ -- SUP: Not sure what the standard says about precision in the following 2 cases
+ primop_rule Float2DoubleOp = one_lit (litCoerce float2DoubleLit)
+ primop_rule Double2FloatOp = one_lit (litCoerce double2FloatLit)
+
+ -- Float
primop_rule FloatAddOp = two_lits (floatOp2 (+))
primop_rule FloatSubOp = two_lits (floatOp2 (-))
primop_rule FloatMulOp = two_lits (floatOp2 (*))
primop_rule FloatDivOp = two_lits (floatOp2Z (/))
primop_rule FloatNegOp = one_lit negOp
- -- Double
+ -- Double
primop_rule DoubleAddOp = two_lits (doubleOp2 (+))
primop_rule DoubleSubOp = two_lits (doubleOp2 (-))
primop_rule DoubleMulOp = two_lits (doubleOp2 (*))
primop_rule DoubleDivOp = two_lits (doubleOp2Z (/))
primop_rule DoubleNegOp = one_lit negOp
- -- Relational operators
- primop_rule IntEqOp = relop (==) ++ litEq op_name True
- primop_rule IntNeOp = relop (/=) ++ litEq op_name False
- primop_rule CharEqOp = relop (==) ++ litEq op_name True
- primop_rule CharNeOp = relop (/=) ++ litEq op_name False
-
- primop_rule IntGtOp = relop (>)
- primop_rule IntGeOp = relop (>=)
- primop_rule IntLeOp = relop (<=)
- primop_rule IntLtOp = relop (<)
-
- primop_rule CharGtOp = relop (>)
- primop_rule CharGeOp = relop (>=)
- primop_rule CharLeOp = relop (<=)
- primop_rule CharLtOp = relop (<)
-
- primop_rule FloatGtOp = relop (>)
- primop_rule FloatGeOp = relop (>=)
- primop_rule FloatLeOp = relop (<=)
- primop_rule FloatLtOp = relop (<)
- primop_rule FloatEqOp = relop (==)
- primop_rule FloatNeOp = relop (/=)
-
- primop_rule DoubleGtOp = relop (>)
- primop_rule DoubleGeOp = relop (>=)
- primop_rule DoubleLeOp = relop (<=)
- primop_rule DoubleLtOp = relop (<)
- primop_rule DoubleEqOp = relop (==)
- primop_rule DoubleNeOp = relop (/=)
-
- primop_rule WordGtOp = relop (>)
- primop_rule WordGeOp = relop (>=)
- primop_rule WordLeOp = relop (<=)
- primop_rule WordLtOp = relop (<)
- primop_rule WordEqOp = relop (==)
- primop_rule WordNeOp = relop (/=)
-
- primop_rule _ = []
+ -- Relational operators
+ primop_rule IntEqOp = relop (==) ++ litEq op_name True
+ primop_rule IntNeOp = relop (/=) ++ litEq op_name False
+ primop_rule CharEqOp = relop (==) ++ litEq op_name True
+ primop_rule CharNeOp = relop (/=) ++ litEq op_name False
+
+ primop_rule IntGtOp = relop (>)
+ primop_rule IntGeOp = relop (>=)
+ primop_rule IntLeOp = relop (<=)
+ primop_rule IntLtOp = relop (<)
+
+ primop_rule CharGtOp = relop (>)
+ primop_rule CharGeOp = relop (>=)
+ primop_rule CharLeOp = relop (<=)
+ primop_rule CharLtOp = relop (<)
+
+ primop_rule FloatGtOp = relop (>)
+ primop_rule FloatGeOp = relop (>=)
+ primop_rule FloatLeOp = relop (<=)
+ primop_rule FloatLtOp = relop (<)
+ primop_rule FloatEqOp = relop (==)
+ primop_rule FloatNeOp = relop (/=)
+
+ primop_rule DoubleGtOp = relop (>)
+ primop_rule DoubleGeOp = relop (>=)
+ primop_rule DoubleLeOp = relop (<=)
+ primop_rule DoubleLtOp = relop (<)
+ primop_rule DoubleEqOp = relop (==)
+ primop_rule DoubleNeOp = relop (/=)
+
+ primop_rule WordGtOp = relop (>)
+ primop_rule WordGeOp = relop (>=)
+ primop_rule WordLeOp = relop (<=)
+ primop_rule WordLtOp = relop (<)
+ primop_rule WordEqOp = relop (==)
+ primop_rule WordNeOp = relop (/=)
+
+ primop_rule _ = []
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Doing the business}
-%* *
+%* *
%************************************************************************
ToDo: the reason these all return Nothing is because there used to be
= go l1 l2
where
done res | cmp res = Just trueVal
- | otherwise = Just falseVal
+ | otherwise = Just falseVal
- -- These compares are at different types
+ -- These compares are at different types
go (MachChar i1) (MachChar i2) = done (i1 `compare` i2)
go (MachInt i1) (MachInt i2) = done (i1 `compare` i2)
go (MachInt64 i1) (MachInt64 i2) = done (i1 `compare` i2)
--------------------------
-negOp :: Literal -> Maybe CoreExpr -- Negate
+negOp :: Literal -> Maybe CoreExpr -- Negate
negOp (MachFloat 0.0) = Nothing -- can't represent -0.0 as a Rational
negOp (MachFloat f) = Just (mkFloatVal (-f))
negOp (MachDouble 0.0) = Nothing
--------------------------
intOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
intOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` i2)
-intOp2 _ _ _ = Nothing -- Could find LitLit
+intOp2 _ _ _ = Nothing -- Could find LitLit
intOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
-- Like intOp2, but Nothing if i2=0
intOp2Z op (MachInt i1) (MachInt i2)
| i2 /= 0 = intResult (i1 `op` i2)
-intOp2Z _ _ _ = Nothing -- LitLit or zero dividend
+intOp2Z _ _ _ = Nothing -- LitLit or zero dividend
intShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr
- -- Shifts take an Int; hence second arg of op is Int
+-- Shifts take an Int; hence second arg of op is Int
intShiftOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` fromInteger i2)
-intShiftOp2 _ _ _ = Nothing
+intShiftOp2 _ _ _ = Nothing
shiftRightLogical :: Integer -> Int -> Integer
-- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do
--- Do this by converting to Word and back. Obviously this won't work for big
+-- Do this by converting to Word and back. Obviously this won't work for big
-- values, but its ok as we use it here
shiftRightLogical x n = fromIntegral (fromInteger x `shiftR` n :: Word)
wordOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
wordOp2 op (MachWord w1) (MachWord w2)
= wordResult (w1 `op` w2)
-wordOp2 _ _ _ = Nothing -- Could find LitLit
+wordOp2 _ _ _ = Nothing -- Could find LitLit
wordOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
wordOp2Z op (MachWord w1) (MachWord w2)
| w2 /= 0 = wordResult (w1 `op` w2)
-wordOp2Z _ _ _ = Nothing -- LitLit or zero dividend
+wordOp2Z _ _ _ = Nothing -- LitLit or zero dividend
wordBitOp2 :: (Integer->Integer->Integer) -> Literal -> Literal
-> Maybe CoreExpr
wordBitOp2 op (MachWord w1) (MachWord w2)
= wordResult (w1 `op` w2)
-wordBitOp2 _ _ _ = Nothing -- Could find LitLit
+wordBitOp2 _ _ _ = Nothing -- Could find LitLit
wordShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr
- -- Shifts take an Int; hence second arg of op is Int
-wordShiftOp2 op (MachWord x) (MachInt n)
+-- Shifts take an Int; hence second arg of op is Int
+wordShiftOp2 op (MachWord x) (MachInt n)
= wordResult (x `op` fromInteger n)
- -- Do the shift at type Integer
-wordShiftOp2 _ _ _ = Nothing
+ -- Do the shift at type Integer
+wordShiftOp2 _ _ _ = Nothing
--------------------------
floatOp2 :: (Rational -> Rational -> Rational) -> Literal -> Literal
--------------------------
- -- This stuff turns
- -- n ==# 3#
- -- into
- -- case n of
- -- 3# -> True
- -- m -> False
- --
- -- This is a Good Thing, because it allows case-of case things
- -- to happen, and case-default absorption to happen. For
- -- example:
- --
- -- if (n ==# 3#) || (n ==# 4#) then e1 else e2
- -- will transform to
- -- case n of
- -- 3# -> e1
- -- 4# -> e1
- -- m -> e2
- -- (modulo the usual precautions to avoid duplicating e1)
-
-litEq :: Name
- -> Bool -- True <=> equality, False <=> inequality
+-- This stuff turns
+-- n ==# 3#
+-- into
+-- case n of
+-- 3# -> True
+-- m -> False
+--
+-- This is a Good Thing, because it allows case-of case things
+-- to happen, and case-default absorption to happen. For
+-- example:
+--
+-- if (n ==# 3#) || (n ==# 4#) then e1 else e2
+-- will transform to
+-- case n of
+-- 3# -> e1
+-- 4# -> e1
+-- m -> e2
+-- (modulo the usual precautions to avoid duplicating e1)
+
+litEq :: Name
+ -> Bool -- True <=> equality, False <=> inequality
-> [CoreRule]
litEq op_name is_eq
- = [BuiltinRule { ru_name = occNameFS (nameOccName op_name)
- `appendFS` (fsLit "->case"),
- ru_fn = op_name,
- ru_nargs = 2, ru_try = rule_fn }]
+ = [BuiltinRule { ru_name = occNameFS (nameOccName op_name)
+ `appendFS` (fsLit "->case"),
+ ru_fn = op_name,
+ ru_nargs = 2, ru_try = rule_fn }]
where
rule_fn _ [Lit lit, expr] = do_lit_eq lit expr
rule_fn _ [expr, Lit lit] = do_lit_eq lit expr
- rule_fn _ _ = Nothing
-
+ rule_fn _ _ = Nothing
+
do_lit_eq lit expr
= Just (mkWildCase expr (literalType lit) boolTy
- [(DEFAULT, [], val_if_neq),
- (LitAlt lit, [], val_if_eq)])
+ [(DEFAULT, [], val_if_neq),
+ (LitAlt lit, [], val_if_eq)])
val_if_eq | is_eq = trueVal
- | otherwise = falseVal
+ | otherwise = falseVal
val_if_neq | is_eq = falseVal
- | otherwise = trueVal
+ | otherwise = trueVal
-- Note that we *don't* warn the user about overflow. It's not done at
-- runtime either, and compilation of completely harmless things like
%************************************************************************
-%* *
-\subsection{Vaguely generic functions
-%* *
+%* *
+\subsection{Vaguely generic functions}
+%* *
%************************************************************************
\begin{code}
-- Gives the Rule the same name as the primop itself
mkBasicRule op_name n_args rule_fn
= [BuiltinRule { ru_name = occNameFS (nameOccName op_name),
- ru_fn = op_name,
- ru_nargs = n_args, ru_try = rule_fn }]
+ ru_fn = op_name,
+ ru_nargs = n_args, ru_try = rule_fn }]
oneLit :: Name -> (Literal -> Maybe CoreExpr)
-> [CoreRule]
rule_fn _ _ = Nothing
twoLits :: Name -> (Literal -> Literal -> Maybe CoreExpr)
- -> [CoreRule]
-twoLits op_name test
+ -> [CoreRule]
+twoLits op_name test
= mkBasicRule op_name 2 rule_fn
where
rule_fn _ [Lit l1, Lit l2] = test (convFloating l1) (convFloating l2)
mkDoubleVal d = Lit (convFloating (MachDouble d))
\end{code}
-
+
%************************************************************************
-%* *
+%* *
\subsection{Special rules for seq, tagToEnum, dataToTag}
-%* *
+%* *
%************************************************************************
Note [tagToEnum#]
check won't see that, alas. It's crude but it works.
Here's are two cases that should fail
- f :: forall a. a
- f = tagToEnum# 0 -- Can't do tagToEnum# at a type variable
+ f :: forall a. a
+ f = tagToEnum# 0 -- Can't do tagToEnum# at a type variable
- g :: Int
- g = tagToEnum# 0 -- Int is not an enumeration
+ g :: Int
+ g = tagToEnum# 0 -- Int is not an enumeration
We used to make this check in the type inference engine, but it's quite
ugly to do so, because the delayed constraint solving means that we don't
| Just (tycon, tc_args) <- splitTyConApp_maybe ty
, isEnumerationTyCon tycon
= case filter correct_tag (tyConDataCons_maybe tycon `orElse` []) of
- [] -> Nothing -- Abstract type
- (dc:rest) -> ASSERT( null rest )
- Just (mkTyApps (Var (dataConWorkId dc)) tc_args)
- | otherwise -- See Note [tagToEnum#]
+ [] -> Nothing -- Abstract type
+ (dc:rest) -> ASSERT( null rest )
+ Just (mkTyApps (Var (dataConWorkId dc)) tc_args)
+ | otherwise -- See Note [tagToEnum#]
= WARN( True, ptext (sLit "tagToEnum# on non-enumeration type") <+> ppr ty )
Just (mkRuntimeErrorApp rUNTIME_ERROR_ID ty "tagToEnum# on non-enumeration type")
- where
+ where
correct_tag dc = (dataConTag dc - fIRST_TAG) == tag
tag = fromInteger i
\end{code}
-For dataToTag#, we can reduce if either
-
- (a) the argument is a constructor
- (b) the argument is a variable whose unfolding is a known constructor
+For dataToTag#, we can reduce if either
+
+ (a) the argument is a constructor
+ (b) the argument is a variable whose unfolding is a known constructor
\begin{code}
dataToTagRule :: IdUnfoldingFun -> [Expr CoreBndr] -> Maybe (Arg CoreBndr)
dataToTagRule _ [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag]
| tag_to_enum `hasKey` tagToEnumKey
, ty1 `coreEqType` ty2
- = Just tag -- dataToTag (tagToEnum x) ==> x
+ = Just tag -- dataToTag (tagToEnum x) ==> x
dataToTagRule id_unf [_, val_arg]
| Just (dc,_,_) <- exprIsConApp_maybe id_unf val_arg
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Built in rules}
-%* *
+%* *
%************************************************************************
Note [Scoping for Builtin rules]
functions mentioned in the RHS of a built-in rule, there's a danger
that we'll see
- f = ...(eq String x)....
+ f = ...(eq String x)....
- ....and lower down...
+ ....and lower down...
- eqString = ...
+ eqString = ...
Then a rewrite would give
- f = ...(eqString x)...
- ....and lower down...
- eqString = ...
+ f = ...(eqString x)...
+ ....and lower down...
+ eqString = ...
and lo, eqString is not in scope. This only really matters when we get to code
generation. With -O we do a GlomBinds step that does a new SCC analysis on the whole
-- Rules for non-primops that can't be expressed using a RULE pragma
builtinRules
= [ BuiltinRule { ru_name = fsLit "AppendLitString", ru_fn = unpackCStringFoldrName,
- ru_nargs = 4, ru_try = match_append_lit },
+ ru_nargs = 4, ru_try = match_append_lit },
BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName,
- ru_nargs = 2, ru_try = match_eq_string },
+ ru_nargs = 2, ru_try = match_eq_string },
BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,
- ru_nargs = 2, ru_try = match_inline }
+ ru_nargs = 2, ru_try = match_inline }
]
---------------------------------------------------
-- The rule is this:
--- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
+-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
-- = unpackFoldrCString# "foobaz" c n
match_append_lit :: IdUnfoldingFun -> [Expr CoreBndr] -> Maybe (Expr CoreBndr)
match_append_lit _ [Type ty1,
- Lit (MachStr s1),
- c1,
- Var unpk `App` Type ty2
- `App` Lit (MachStr s2)
- `App` c2
- `App` n
- ]
- | unpk `hasKey` unpackCStringFoldrIdKey &&
+ Lit (MachStr s1),
+ c1,
+ Var unpk `App` Type ty2
+ `App` Lit (MachStr s2)
+ `App` c2
+ `App` n
+ ]
+ | unpk `hasKey` unpackCStringFoldrIdKey &&
c1 `cheapEqExpr` c2
= ASSERT( ty1 `coreEqType` ty2 )
Just (Var unpk `App` Type ty1
- `App` Lit (MachStr (s1 `appendFS` s2))
- `App` c1
- `App` n)
+ `App` Lit (MachStr (s1 `appendFS` s2))
+ `App` c1
+ `App` n)
match_append_lit _ _ = Nothing
---------------------------------------------------
-- The rule is this:
--- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
+-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
match_eq_string :: IdUnfoldingFun -> [Expr CoreBndr] -> Maybe (Expr CoreBndr)
match_eq_string _ [Var unpk1 `App` Lit (MachStr s1),
- Var unpk2 `App` Lit (MachStr s2)]
+ Var unpk2 `App` Lit (MachStr s2)]
| unpk1 `hasKey` unpackCStringIdKey,
unpk2 `hasKey` unpackCStringIdKey
= Just (if s1 == s2 then trueVal else falseVal)
---------------------------------------------------
-- The rule is this:
--- inline f_ty (f a b c) = <f's unfolding> a b c
+-- inline f_ty (f a b c) = <f's unfolding> a b c
-- (if f has an unfolding, EVEN if it's a loop breaker)
--
-- It's important to allow the argument to 'inline' to have args itself
-- (a) because its more forgiving to allow the programmer to write
--- inline f a b c
+-- inline f a b c
-- or inline (f a b c)
--- (b) because a polymorphic f wll get a type argument that the
+-- (b) because a polymorphic f wll get a type argument that the
-- programmer can't avoid
--
-- Also, don't forget about 'inline's type argument!
match_inline _ (Type _ : e : _)
| (Var f, args1) <- collectArgs e,
Just unf <- maybeUnfoldingTemplate (realIdUnfolding f)
- -- Ignore the IdUnfoldingFun here!
+ -- Ignore the IdUnfoldingFun here!
= Just (mkApps unf args1)
match_inline _ _ = Nothing
\end{code}
-
projects / ghc-hetmet.git / commitdiff