Fix CodingStyle#Warnings URLs
[ghc-hetmet.git] / compiler / prelude / PrelRules.lhs
index f179955..10cc821 100644 (file)
@@ -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,17 +47,12 @@ 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}
 
 
@@ -77,122 +79,116 @@ example:
 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}
 
 %************************************************************************
@@ -210,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
@@ -230,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))
@@ -305,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
 
@@ -330,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}
 
 
@@ -345,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
@@ -365,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)
@@ -423,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 }
     ]
 
 
@@ -470,12 +534,21 @@ match_eq_string other = Nothing
 
 ---------------------------------------------------
 -- The rule is this:
---     inline (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)
-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}