X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FPrelRules.lhs;h=10cc821e259a6d6731707b0e68e924da992d3529;hp=1a0a39eff148aefc5e74881334c1c26dbe73aa4c;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=49c98d143c382a1341e1046f5ca00819a25691ba diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index 1a0a39e..10cc821 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -15,6 +15,13 @@ ToDo: {-# OPTIONS -optc-DNON_POSIX_SOURCE #-} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module PrelRules ( primOpRules, builtinRules ) where #include "HsVersions.h" @@ -28,9 +35,9 @@ import Literal ( Literal(..), mkMachInt, mkMachWord , narrow8WordLit, narrow16WordLit, narrow32WordLit , char2IntLit, int2CharLit , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit - , float2DoubleLit, double2FloatLit + , float2DoubleLit, double2FloatLit, litFitsInChar ) -import PrimOp ( PrimOp(..), primOpOcc, tagToEnumKey ) +import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn ( boolTy, trueDataConId, falseDataConId ) import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon ) import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG ) @@ -40,140 +47,148 @@ import OccName ( occNameFS ) import PrelNames ( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey, eqStringName, unpackCStringIdKey, inlineIdName ) import Maybes ( orElse ) -import Name ( Name ) +import Name ( Name, nameOccName ) import Outputable import FastString import StaticFlags ( opt_SimplExcessPrecision ) - -import Data.Bits ( Bits(..) ) -#if __GLASGOW_HASKELL__ >= 500 +import Data.Bits as Bits import Data.Word ( Word ) -#else -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 where - rule_name = occNameFS (primOpOcc op) - rule_name_case = rule_name `appendFS` FSLIT("->case") - -- A useful shorthand - one_rule rule_fn = [BuiltinRule { ru_name = rule_name, - ru_fn = op_name, - ru_try = rule_fn }] - case_rule rule_fn = [BuiltinRule { ru_name = rule_name_case, - ru_fn = op_name, - ru_try = rule_fn }] + 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. -- ToDo: something for integer-shift ops? -- NotOp - primop_rule TagToEnumOp = one_rule tagToEnumRule - primop_rule DataToTagOp = one_rule dataToTagRule + primop_rule TagToEnumOp = mkBasicRule op_name 2 tagToEnumRule + primop_rule DataToTagOp = mkBasicRule op_name 2 dataToTagRule -- Int operations - primop_rule IntAddOp = one_rule (twoLits (intOp2 (+))) - primop_rule IntSubOp = one_rule (twoLits (intOp2 (-))) - primop_rule IntMulOp = one_rule (twoLits (intOp2 (*))) - primop_rule IntQuotOp = one_rule (twoLits (intOp2Z quot)) - primop_rule IntRemOp = one_rule (twoLits (intOp2Z rem)) - primop_rule IntNegOp = one_rule (oneLit negOp) + primop_rule IntAddOp = two_lits (intOp2 (+)) + primop_rule IntSubOp = two_lits (intOp2 (-)) + primop_rule IntMulOp = two_lits (intOp2 (*)) + primop_rule IntQuotOp = two_lits (intOp2Z quot) + primop_rule IntRemOp = two_lits (intOp2Z rem) + primop_rule IntNegOp = one_lit negOp + primop_rule ISllOp = two_lits (intShiftOp2 Bits.shiftL) + primop_rule ISraOp = two_lits (intShiftOp2 Bits.shiftR) + primop_rule ISrlOp = two_lits (intShiftOp2 shiftRightLogical) -- Word operations -#if __GLASGOW_HASKELL__ >= 500 - primop_rule WordAddOp = one_rule (twoLits (wordOp2 (+))) - primop_rule WordSubOp = one_rule (twoLits (wordOp2 (-))) - primop_rule WordMulOp = one_rule (twoLits (wordOp2 (*))) -#endif - primop_rule WordQuotOp = one_rule (twoLits (wordOp2Z quot)) - primop_rule WordRemOp = one_rule (twoLits (wordOp2Z rem)) -#if __GLASGOW_HASKELL__ >= 407 - primop_rule AndOp = one_rule (twoLits (wordBitOp2 (.&.))) - primop_rule OrOp = one_rule (twoLits (wordBitOp2 (.|.))) - primop_rule XorOp = one_rule (twoLits (wordBitOp2 xor)) -#endif + primop_rule WordAddOp = two_lits (wordOp2 (+)) + primop_rule WordSubOp = two_lits (wordOp2 (-)) + primop_rule WordMulOp = two_lits (wordOp2 (*)) + primop_rule WordQuotOp = two_lits (wordOp2Z quot) + primop_rule WordRemOp = two_lits (wordOp2Z rem) + primop_rule AndOp = two_lits (wordBitOp2 (.&.)) + primop_rule OrOp = two_lits (wordBitOp2 (.|.)) + primop_rule XorOp = two_lits (wordBitOp2 xor) + primop_rule SllOp = two_lits (wordShiftOp2 Bits.shiftL) + primop_rule SrlOp = two_lits (wordShiftOp2 shiftRightLogical) -- coercions - primop_rule Word2IntOp = one_rule (oneLit (litCoerce word2IntLit)) - primop_rule Int2WordOp = one_rule (oneLit (litCoerce int2WordLit)) - primop_rule Narrow8IntOp = one_rule (oneLit (litCoerce narrow8IntLit)) - primop_rule Narrow16IntOp = one_rule (oneLit (litCoerce narrow16IntLit)) - primop_rule Narrow32IntOp = one_rule (oneLit (litCoerce narrow32IntLit)) - primop_rule Narrow8WordOp = one_rule (oneLit (litCoerce narrow8WordLit)) - primop_rule Narrow16WordOp = one_rule (oneLit (litCoerce narrow16WordLit)) - primop_rule Narrow32WordOp = one_rule (oneLit (litCoerce narrow32WordLit)) - primop_rule OrdOp = one_rule (oneLit (litCoerce char2IntLit)) - primop_rule ChrOp = one_rule (oneLit (litCoerce int2CharLit)) - primop_rule Float2IntOp = one_rule (oneLit (litCoerce float2IntLit)) - primop_rule Int2FloatOp = one_rule (oneLit (litCoerce int2FloatLit)) - primop_rule Double2IntOp = one_rule (oneLit (litCoerce double2IntLit)) - primop_rule Int2DoubleOp = one_rule (oneLit (litCoerce int2DoubleLit)) + 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_rule (oneLit (litCoerce float2DoubleLit)) - primop_rule Double2FloatOp = one_rule (oneLit (litCoerce double2FloatLit)) + primop_rule Float2DoubleOp = one_lit (litCoerce float2DoubleLit) + primop_rule Double2FloatOp = one_lit (litCoerce double2FloatLit) -- Float - primop_rule FloatAddOp = one_rule (twoLits (floatOp2 (+))) - primop_rule FloatSubOp = one_rule (twoLits (floatOp2 (-))) - primop_rule FloatMulOp = one_rule (twoLits (floatOp2 (*))) - primop_rule FloatDivOp = one_rule (twoLits (floatOp2Z (/))) - primop_rule FloatNegOp = one_rule (oneLit negOp) + 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 - primop_rule DoubleAddOp = one_rule (twoLits (doubleOp2 (+))) - primop_rule DoubleSubOp = one_rule (twoLits (doubleOp2 (-))) - primop_rule DoubleMulOp = one_rule (twoLits (doubleOp2 (*))) - primop_rule DoubleDivOp = one_rule (twoLits (doubleOp2Z (/))) - primop_rule DoubleNegOp = one_rule (oneLit negOp) + 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 = one_rule (relop (==)) ++ case_rule (litEq True) - primop_rule IntNeOp = one_rule (relop (/=)) ++ case_rule (litEq False) - primop_rule CharEqOp = one_rule (relop (==)) ++ case_rule (litEq True) - primop_rule CharNeOp = one_rule (relop (/=)) ++ case_rule (litEq False) - - primop_rule IntGtOp = one_rule (relop (>)) - primop_rule IntGeOp = one_rule (relop (>=)) - primop_rule IntLeOp = one_rule (relop (<=)) - primop_rule IntLtOp = one_rule (relop (<)) - - primop_rule CharGtOp = one_rule (relop (>)) - primop_rule CharGeOp = one_rule (relop (>=)) - primop_rule CharLeOp = one_rule (relop (<=)) - primop_rule CharLtOp = one_rule (relop (<)) - - primop_rule FloatGtOp = one_rule (relop (>)) - primop_rule FloatGeOp = one_rule (relop (>=)) - primop_rule FloatLeOp = one_rule (relop (<=)) - primop_rule FloatLtOp = one_rule (relop (<)) - primop_rule FloatEqOp = one_rule (relop (==)) - primop_rule FloatNeOp = one_rule (relop (/=)) - - primop_rule DoubleGtOp = one_rule (relop (>)) - primop_rule DoubleGeOp = one_rule (relop (>=)) - primop_rule DoubleLeOp = one_rule (relop (<=)) - primop_rule DoubleLtOp = one_rule (relop (<)) - primop_rule DoubleEqOp = one_rule (relop (==)) - primop_rule DoubleNeOp = one_rule (relop (/=)) - - primop_rule WordGtOp = one_rule (relop (>)) - primop_rule WordGeOp = one_rule (relop (>=)) - primop_rule WordLeOp = one_rule (relop (<=)) - primop_rule WordLtOp = one_rule (relop (<)) - primop_rule WordEqOp = one_rule (relop (==)) - primop_rule WordNeOp = one_rule (relop (/=)) + 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 other = [] - relop cmp = twoLits (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. \end{code} %************************************************************************ @@ -191,6 +206,11 @@ so this could be cleaned up. litCoerce :: (Literal -> Literal) -> Literal -> Maybe CoreExpr litCoerce fn lit = Just (Lit (fn lit)) +predLitCoerce :: (Literal -> Bool) -> (Literal -> Literal) -> Literal -> Maybe CoreExpr +predLitCoerce p fn lit + | p lit = Just (Lit (fn lit)) + | otherwise = Nothing + -------------------------- cmpOp :: (Ordering -> Bool) -> Literal -> Literal -> Maybe CoreExpr cmpOp cmp l1 l2 @@ -211,42 +231,59 @@ cmpOp cmp l1 l2 -------------------------- -negOp (MachFloat 0.0) = Nothing -- can't represent -0.0 as a Rational -negOp (MachFloat f) = Just (mkFloatVal (-f)) +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 negOp (MachDouble d) = Just (mkDoubleVal (-d)) negOp (MachInt i) = intResult (-i) negOp l = Nothing -------------------------- +intOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr intOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` i2) intOp2 op l1 l2 = 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 = Just (mkIntVal (i1 `op` i2)) + | i2 /= 0 = intResult (i1 `op` i2) intOp2Z op l1 l2 = Nothing -- LitLit or zero dividend +intShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr + -- Shifts take an Int; hence second arg of op is Int +intShiftOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` fromInteger i2) +intShiftOp2 op l1 l2 = 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 +-- values, but its ok as we use it here +shiftRightLogical x n = fromIntegral (fromInteger x `shiftR` n :: Word) + + -------------------------- -#if __GLASGOW_HASKELL__ >= 500 +wordOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr wordOp2 op (MachWord w1) (MachWord w2) = wordResult (w1 `op` w2) wordOp2 op l1 l2 = Nothing -- Could find LitLit -#endif +wordOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr wordOp2Z op (MachWord w1) (MachWord w2) - | w2 /= 0 = Just (mkWordVal (w1 `op` w2)) + | w2 /= 0 = wordResult (w1 `op` w2) wordOp2Z op l1 l2 = Nothing -- LitLit or zero dividend -#if __GLASGOW_HASKELL__ >= 500 -wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2) - = Just (mkWordVal (w1 `op` w2)) -#else --- Integer is not an instance of Bits, so we operate on Word64 wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2) - = Just (mkWordVal ((fromIntegral::Word64->Integer) (fromIntegral w1 `op` fromIntegral w2))) -#endif + = wordResult (w1 `op` w2) wordBitOp2 op l1 l2 = 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) + = wordResult (x `op` fromInteger n) + -- Do the shift at type Integer +wordShiftOp2 op l1 l2 = Nothing + -------------------------- floatOp2 op (MachFloat f1) (MachFloat f2) = Just (mkFloatVal (f1 `op` f2)) @@ -286,19 +323,25 @@ doubleOp2Z op l1 l2 = Nothing -- m -> e2 -- (modulo the usual precautions to avoid duplicating e1) -litEq :: Bool -- True <=> equality, False <=> inequality - -> RuleFun -litEq is_eq [Lit lit, expr] = do_lit_eq is_eq lit expr -litEq is_eq [expr, Lit lit] = do_lit_eq is_eq lit expr -litEq is_eq other = Nothing - -do_lit_eq is_eq lit expr - = Just (Case expr (mkWildId (literalType lit)) boolTy - [(DEFAULT, [], val_if_neq), - (LitAlt lit, [], val_if_eq)]) +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 }] where + rule_fn [Lit lit, expr] = do_lit_eq lit expr + rule_fn [expr, Lit lit] = do_lit_eq lit expr + rule_fn other = Nothing + + do_lit_eq lit expr + = Just (Case expr (mkWildId (literalType lit)) boolTy + [(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 @@ -311,11 +354,9 @@ intResult :: Integer -> Maybe CoreExpr intResult result = Just (mkIntVal (toInteger (fromInteger result :: Int))) -#if __GLASGOW_HASKELL__ >= 500 wordResult :: Integer -> Maybe CoreExpr wordResult result = Just (mkWordVal (toInteger (fromInteger result :: Word))) -#endif \end{code} @@ -326,15 +367,28 @@ wordResult result %************************************************************************ \begin{code} -type RuleFun = [CoreExpr] -> Maybe CoreExpr - -twoLits :: (Literal -> Literal -> Maybe CoreExpr) -> RuleFun -twoLits rule [Lit l1, Lit l2] = rule (convFloating l1) (convFloating l2) -twoLits rule _ = Nothing +mkBasicRule :: Name -> Int -> ([CoreExpr] -> Maybe CoreExpr) -> [CoreRule] +-- 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 }] + +oneLit :: Name -> (Literal -> Maybe CoreExpr) + -> [CoreRule] +oneLit op_name test + = mkBasicRule op_name 1 rule_fn + where + rule_fn [Lit l1] = test (convFloating l1) + rule_fn _ = Nothing -oneLit :: (Literal -> Maybe CoreExpr) -> RuleFun -oneLit rule [Lit l1] = rule (convFloating l1) -oneLit rule _ = Nothing +twoLits :: Name -> (Literal -> Literal -> Maybe CoreExpr) + -> [CoreRule] +twoLits op_name test + = mkBasicRule op_name 2 rule_fn + where + rule_fn [Lit l1, Lit l2] = test (convFloating l1) (convFloating l2) + rule_fn _ = Nothing -- When excess precision is not requested, cut down the precision of the -- Rational value to that of Float/Double. We confuse host architecture @@ -346,7 +400,6 @@ convFloating (MachDouble d) | not opt_SimplExcessPrecision = MachDouble (toRational ((fromRational d) :: Double)) convFloating l = l - trueVal = Var trueDataConId falseVal = Var falseDataConId mkIntVal i = Lit (mkMachInt i) @@ -404,13 +457,43 @@ dataToTagRule other = Nothing %* * %************************************************************************ +Note [Scoping for Builtin rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When compiling a (base-package) module that defines one of the +functions mentioned in the RHS of a built-in rule, there's a danger +that we'll see + + f = ...(eq String x).... + + ....and lower down... + + eqString = ... + +Then a rewrite would give + + 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 +set of bindings, which sorts out the dependency. Without -O we don't do any rule +rewriting so again we are fine. + +(This whole thing doesn't show up for non-built-in rules because their dependencies +are explicit.) + + \begin{code} 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("Inline") inlineIdName match_inline + = [ BuiltinRule { ru_name = FSLIT("AppendLitString"), ru_fn = unpackCStringFoldrName, + ru_nargs = 4, ru_try = match_append_lit }, + BuiltinRule { ru_name = FSLIT("EqString"), ru_fn = eqStringName, + ru_nargs = 2, ru_try = match_eq_string }, + BuiltinRule { ru_name = FSLIT("Inline"), ru_fn = inlineIdName, + ru_nargs = 2, ru_try = match_inline } ] @@ -451,12 +534,21 @@ match_eq_string other = Nothing --------------------------------------------------- -- The rule is this: --- inline (f a b c) = a b c +-- inline f_ty (f a b c) = a b c -- (if f has an unfolding) -match_inline (e:args2) +-- +-- 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 +-- or inline (f a b c) +-- (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 (idUnfolding f) - = Just (mkApps (mkApps unf args1) args2) + = Just (mkApps unf args1) match_inline other = Nothing \end{code}