compiler/prelude/PrelRules.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[ConFold]{Constant Folder}
   5
   6 Conceptually, constant folding should be parameterized with the kind
   7 of target machine to get identical behaviour during compilation time
   8 and runtime. We cheat a little bit here...
   9
  10 ToDo:
  11    check boundaries before folding, e.g. we can fold the Float addition
  12    (i1 + i2) only if it results in a valid Float.
  13
  14 \begin{code}
  15
  16 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
  17
  18 {-# OPTIONS -w #-}
  19 -- The above warning supression flag is a temporary kludge.
  20 -- While working on this module you are encouraged to remove it and fix
  21 -- any warnings in the module. See
  22 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  23 -- for details
  24
  25 module PrelRules ( primOpRules, builtinRules ) where
  26
  27 #include "HsVersions.h"
  28
  29 import CoreSyn
  30 import Id               ( mkWildId, idUnfolding )
  31 import Literal          ( Literal(..), mkMachInt, mkMachWord
  32                         , literalType
  33                         , word2IntLit, int2WordLit
  34                         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  35                         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  36                         , char2IntLit, int2CharLit
  37                         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  38                         , float2DoubleLit, double2FloatLit, litFitsInChar
  39                         )
  40 import PrimOp           ( PrimOp(..), tagToEnumKey )
  41 import TysWiredIn       ( boolTy, trueDataConId, falseDataConId )
  42 import TyCon            ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
  43 import DataCon          ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
  44 import CoreUtils        ( cheapEqExpr, exprIsConApp_maybe )
  45 import Type             ( tyConAppTyCon, coreEqType )
  46 import OccName          ( occNameFS )
  47 import PrelNames        ( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey,
  48                           eqStringName, unpackCStringIdKey, inlineIdName )
  49 import Maybes           ( orElse )
  50 import Name             ( Name, nameOccName )
  51 import Outputable
  52 import FastString
  53 import StaticFlags      ( opt_SimplExcessPrecision )
  54 import Data.Bits as Bits
  55 import Data.Word        ( Word )
  56 \end{code}
  57
  58
  59 Note [Constant folding]
  60 ~~~~~~~~~~~~~~~~~~~~~~~
  61 primOpRules generates the rewrite rules for each primop
  62 These rules do what is often called "constant folding"
  63 E.g. the rules for +# might say
  64              4 +# 5 = 9
  65 Well, of course you'd need a lot of rules if you did it
  66 like that, so we use a BuiltinRule instead, so that we
  67 can match in any two literal values.  So the rule is really
  68 more like
  69              (Lit 4) +# (Lit y) = Lit (x+#y)
  70 where the (+#) on the rhs is done at compile time
  71
  72 That is why these rules are built in here.  Other rules
  73 which don't need to be built in are in GHC.Base. For
  74 example:
  75         x +# 0 = x
  76
  77
  78 \begin{code}
  79 primOpRules :: PrimOp -> Name -> [CoreRule]
  80 primOpRules op op_name = primop_rule op
  81   where
  82         -- A useful shorthand
  83     one_lit   = oneLit  op_name
  84     two_lits  = twoLits op_name
  85     relop cmp = two_lits (cmpOp (\ord -> ord `cmp` EQ))
  86         -- Cunning.  cmpOp compares the values to give an Ordering.
  87         -- It applies its argument to that ordering value to turn
  88         -- the ordering into a boolean value.  (`cmp` EQ) is just the job.
  89
  90     -- ToDo:    something for integer-shift ops?
  91     --          NotOp
  92
  93     primop_rule TagToEnumOp = mkBasicRule op_name 2 tagToEnumRule
  94     primop_rule DataToTagOp = mkBasicRule op_name 2 dataToTagRule
  95
  96         -- Int operations
  97     primop_rule IntAddOp    = two_lits (intOp2     (+))
  98     primop_rule IntSubOp    = two_lits (intOp2     (-))
  99     primop_rule IntMulOp    = two_lits (intOp2     (*))
 100     primop_rule IntQuotOp   = two_lits (intOp2Z    quot)
 101     primop_rule IntRemOp    = two_lits (intOp2Z    rem)
 102     primop_rule IntNegOp    = one_lit  negOp
 103     primop_rule ISllOp      = two_lits (intShiftOp2 Bits.shiftL)
 104     primop_rule ISraOp      = two_lits (intShiftOp2 Bits.shiftR)
 105     primop_rule ISrlOp      = two_lits (intShiftOp2 shiftRightLogical)
 106
 107         -- Word operations
 108     primop_rule WordAddOp   = two_lits (wordOp2    (+))
 109     primop_rule WordSubOp   = two_lits (wordOp2    (-))
 110     primop_rule WordMulOp   = two_lits (wordOp2    (*))
 111     primop_rule WordQuotOp  = two_lits (wordOp2Z   quot)
 112     primop_rule WordRemOp   = two_lits (wordOp2Z   rem)
 113     primop_rule AndOp       = two_lits (wordBitOp2 (.&.))
 114     primop_rule OrOp        = two_lits (wordBitOp2 (.|.))
 115     primop_rule XorOp       = two_lits (wordBitOp2 xor)
 116     primop_rule SllOp       = two_lits (wordShiftOp2 Bits.shiftL)
 117     primop_rule SrlOp       = two_lits (wordShiftOp2 shiftRightLogical)
 118
 119         -- coercions
 120     primop_rule Word2IntOp      = one_lit (litCoerce word2IntLit)
 121     primop_rule Int2WordOp      = one_lit (litCoerce int2WordLit)
 122     primop_rule Narrow8IntOp    = one_lit (litCoerce narrow8IntLit)
 123     primop_rule Narrow16IntOp   = one_lit (litCoerce narrow16IntLit)
 124     primop_rule Narrow32IntOp   = one_lit (litCoerce narrow32IntLit)
 125     primop_rule Narrow8WordOp   = one_lit (litCoerce narrow8WordLit)
 126     primop_rule Narrow16WordOp  = one_lit (litCoerce narrow16WordLit)
 127     primop_rule Narrow32WordOp  = one_lit (litCoerce narrow32WordLit)
 128     primop_rule OrdOp           = one_lit (litCoerce char2IntLit)
 129     primop_rule ChrOp           = one_lit (predLitCoerce litFitsInChar int2CharLit)
 130     primop_rule Float2IntOp     = one_lit (litCoerce float2IntLit)
 131     primop_rule Int2FloatOp     = one_lit (litCoerce int2FloatLit)
 132     primop_rule Double2IntOp    = one_lit (litCoerce double2IntLit)
 133     primop_rule Int2DoubleOp    = one_lit (litCoerce int2DoubleLit)
 134         -- SUP: Not sure what the standard says about precision in the following 2 cases
 135     primop_rule Float2DoubleOp  = one_lit (litCoerce float2DoubleLit)
 136     primop_rule Double2FloatOp  = one_lit (litCoerce double2FloatLit)
 137
 138         -- Float
 139     primop_rule FloatAddOp   = two_lits (floatOp2  (+))
 140     primop_rule FloatSubOp   = two_lits (floatOp2  (-))
 141     primop_rule FloatMulOp   = two_lits (floatOp2  (*))
 142     primop_rule FloatDivOp   = two_lits (floatOp2Z (/))
 143     primop_rule FloatNegOp   = one_lit  negOp
 144
 145         -- Double
 146     primop_rule DoubleAddOp   = two_lits (doubleOp2  (+))
 147     primop_rule DoubleSubOp   = two_lits (doubleOp2  (-))
 148     primop_rule DoubleMulOp   = two_lits (doubleOp2  (*))
 149     primop_rule DoubleDivOp   = two_lits (doubleOp2Z (/))
 150     primop_rule DoubleNegOp   = one_lit  negOp
 151
 152         -- Relational operators
 153     primop_rule IntEqOp  = relop (==) ++ litEq op_name True
 154     primop_rule IntNeOp  = relop (/=) ++ litEq op_name False
 155     primop_rule CharEqOp = relop (==) ++ litEq op_name True
 156     primop_rule CharNeOp = relop (/=) ++ litEq op_name False
 157
 158     primop_rule IntGtOp         = relop (>)
 159     primop_rule IntGeOp         = relop (>=)
 160     primop_rule IntLeOp         = relop (<=)
 161     primop_rule IntLtOp         = relop (<)
 162
 163     primop_rule CharGtOp        = relop (>)
 164     primop_rule CharGeOp        = relop (>=)
 165     primop_rule CharLeOp        = relop (<=)
 166     primop_rule CharLtOp        = relop (<)
 167
 168     primop_rule FloatGtOp       = relop (>)
 169     primop_rule FloatGeOp       = relop (>=)
 170     primop_rule FloatLeOp       = relop (<=)
 171     primop_rule FloatLtOp       = relop (<)
 172     primop_rule FloatEqOp       = relop (==)
 173     primop_rule FloatNeOp       = relop (/=)
 174
 175     primop_rule DoubleGtOp      = relop (>)
 176     primop_rule DoubleGeOp      = relop (>=)
 177     primop_rule DoubleLeOp      = relop (<=)
 178     primop_rule DoubleLtOp      = relop (<)
 179     primop_rule DoubleEqOp      = relop (==)
 180     primop_rule DoubleNeOp      = relop (/=)
 181
 182     primop_rule WordGtOp        = relop (>)
 183     primop_rule WordGeOp        = relop (>=)
 184     primop_rule WordLeOp        = relop (<=)
 185     primop_rule WordLtOp        = relop (<)
 186     primop_rule WordEqOp        = relop (==)
 187     primop_rule WordNeOp        = relop (/=)
 188
 189     primop_rule other           = []
 190
 191
 192 \end{code}
 193
 194 %************************************************************************
 195 %*                                                                      *
 196 \subsection{Doing the business}
 197 %*                                                                      *
 198 %************************************************************************
 199
 200 ToDo: the reason these all return Nothing is because there used to be
 201 the possibility of an argument being a litlit.  Litlits are now gone,
 202 so this could be cleaned up.
 203
 204 \begin{code}
 205 --------------------------
 206 litCoerce :: (Literal -> Literal) -> Literal -> Maybe CoreExpr
 207 litCoerce fn lit = Just (Lit (fn lit))
 208
 209 predLitCoerce :: (Literal -> Bool) -> (Literal -> Literal) -> Literal -> Maybe CoreExpr
 210 predLitCoerce p fn lit
 211    | p lit     = Just (Lit (fn lit))
 212    | otherwise = Nothing
 213
 214 --------------------------
 215 cmpOp :: (Ordering -> Bool) -> Literal -> Literal -> Maybe CoreExpr
 216 cmpOp cmp l1 l2
 217   = go l1 l2
 218   where
 219     done res | cmp res   = Just trueVal
 220              | otherwise = Just falseVal
 221
 222         -- These compares are at different types
 223     go (MachChar i1)   (MachChar i2)   = done (i1 `compare` i2)
 224     go (MachInt i1)    (MachInt i2)    = done (i1 `compare` i2)
 225     go (MachInt64 i1)  (MachInt64 i2)  = done (i1 `compare` i2)
 226     go (MachWord i1)   (MachWord i2)   = done (i1 `compare` i2)
 227     go (MachWord64 i1) (MachWord64 i2) = done (i1 `compare` i2)
 228     go (MachFloat i1)  (MachFloat i2)  = done (i1 `compare` i2)
 229     go (MachDouble i1) (MachDouble i2) = done (i1 `compare` i2)
 230     go l1              l2              = Nothing
 231
 232 --------------------------
 233
 234 negOp :: Literal -> Maybe CoreExpr      -- Negate
 235 negOp (MachFloat 0.0)  = Nothing  -- can't represent -0.0 as a Rational
 236 negOp (MachFloat f)    = Just (mkFloatVal (-f))
 237 negOp (MachDouble 0.0) = Nothing
 238 negOp (MachDouble d)   = Just (mkDoubleVal (-d))
 239 negOp (MachInt i)      = intResult (-i)
 240 negOp l                = Nothing
 241
 242 --------------------------
 243 intOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
 244 intOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` i2)
 245 intOp2 op l1           l2           = Nothing           -- Could find LitLit
 246
 247 intOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
 248 -- Like intOp2, but Nothing if i2=0
 249 intOp2Z op (MachInt i1) (MachInt i2)
 250   | i2 /= 0 = intResult (i1 `op` i2)
 251 intOp2Z op l1 l2 = Nothing              -- LitLit or zero dividend
 252
 253 intShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr
 254         -- Shifts take an Int; hence second arg of op is Int
 255 intShiftOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` fromInteger i2)
 256 intShiftOp2 op l1           l2           = Nothing
 257
 258 shiftRightLogical :: Integer -> Int -> Integer
 259 -- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do
 260 -- Do this by converting to Word and back.  Obviously this won't work for big
 261 -- values, but its ok as we use it here
 262 shiftRightLogical x n = fromIntegral (fromInteger x `shiftR` n :: Word)
 263
 264
 265 --------------------------
 266 wordOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
 267 wordOp2 op (MachWord w1) (MachWord w2)
 268   = wordResult (w1 `op` w2)
 269 wordOp2 op l1 l2 = Nothing              -- Could find LitLit
 270
 271 wordOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
 272 wordOp2Z op (MachWord w1) (MachWord w2)
 273   | w2 /= 0 = wordResult (w1 `op` w2)
 274 wordOp2Z op l1 l2 = Nothing     -- LitLit or zero dividend
 275
 276 wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2)
 277   = wordResult (w1 `op` w2)
 278 wordBitOp2 op l1 l2 = Nothing           -- Could find LitLit
 279
 280 wordShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr
 281         -- Shifts take an Int; hence second arg of op is Int
 282 wordShiftOp2 op (MachWord x) (MachInt n)
 283   = wordResult (x `op` fromInteger n)
 284         -- Do the shift at type Integer
 285 wordShiftOp2 op l1 l2 = Nothing
 286
 287 --------------------------
 288 floatOp2  op (MachFloat f1) (MachFloat f2)
 289   = Just (mkFloatVal (f1 `op` f2))
 290 floatOp2  op l1 l2 = Nothing
 291
 292 floatOp2Z op (MachFloat f1) (MachFloat f2)
 293   | f2 /= 0   = Just (mkFloatVal (f1 `op` f2))
 294 floatOp2Z op l1 l2 = Nothing
 295
 296 --------------------------
 297 doubleOp2  op (MachDouble f1) (MachDouble f2)
 298   = Just (mkDoubleVal (f1 `op` f2))
 299 doubleOp2 op l1 l2 = Nothing
 300
 301 doubleOp2Z op (MachDouble f1) (MachDouble f2)
 302   | f2 /= 0   = Just (mkDoubleVal (f1 `op` f2))
 303 doubleOp2Z op l1 l2 = Nothing
 304
 305
 306 --------------------------
 307         -- This stuff turns
 308         --      n ==# 3#
 309         -- into
 310         --      case n of
 311         --        3# -> True
 312         --        m  -> False
 313         --
 314         -- This is a Good Thing, because it allows case-of case things
 315         -- to happen, and case-default absorption to happen.  For
 316         -- example:
 317         --
 318         --      if (n ==# 3#) || (n ==# 4#) then e1 else e2
 319         -- will transform to
 320         --      case n of
 321         --        3# -> e1
 322         --        4# -> e1
 323         --        m  -> e2
 324         -- (modulo the usual precautions to avoid duplicating e1)
 325
 326 litEq :: Name
 327       -> Bool           -- True <=> equality, False <=> inequality
 328       -> [CoreRule]
 329 litEq op_name is_eq
 330   = [BuiltinRule { ru_name = occNameFS (nameOccName op_name)
 331                                 `appendFS` (fsLit "->case"),
 332                    ru_fn = op_name,
 333                    ru_nargs = 2, ru_try = rule_fn }]
 334   where
 335     rule_fn [Lit lit, expr] = do_lit_eq lit expr
 336     rule_fn [expr, Lit lit] = do_lit_eq lit expr
 337     rule_fn other           = Nothing
 338
 339     do_lit_eq lit expr
 340       = Just (Case expr (mkWildId (literalType lit)) boolTy
 341                     [(DEFAULT,    [], val_if_neq),
 342                      (LitAlt lit, [], val_if_eq)])
 343     val_if_eq  | is_eq     = trueVal
 344                | otherwise = falseVal
 345     val_if_neq | is_eq     = falseVal
 346                | otherwise = trueVal
 347
 348 -- Note that we *don't* warn the user about overflow. It's not done at
 349 -- runtime either, and compilation of completely harmless things like
 350 --    ((124076834 :: Word32) + (2147483647 :: Word32))
 351 -- would yield a warning. Instead we simply squash the value into the
 352 -- Int range, but not in a way suitable for cross-compiling... :-(
 353 intResult :: Integer -> Maybe CoreExpr
 354 intResult result
 355   = Just (mkIntVal (toInteger (fromInteger result :: Int)))
 356
 357 wordResult :: Integer -> Maybe CoreExpr
 358 wordResult result
 359   = Just (mkWordVal (toInteger (fromInteger result :: Word)))
 360 \end{code}
 361
 362
 363 %************************************************************************
 364 %*                                                                      *
 365 \subsection{Vaguely generic functions
 366 %*                                                                      *
 367 %************************************************************************
 368
 369 \begin{code}
 370 mkBasicRule :: Name -> Int -> ([CoreExpr] -> Maybe CoreExpr) -> [CoreRule]
 371 -- Gives the Rule the same name as the primop itself
 372 mkBasicRule op_name n_args rule_fn
 373   = [BuiltinRule { ru_name = occNameFS (nameOccName op_name),
 374                    ru_fn = op_name,
 375                    ru_nargs = n_args, ru_try = rule_fn }]
 376
 377 oneLit :: Name -> (Literal -> Maybe CoreExpr)
 378        -> [CoreRule]
 379 oneLit op_name test
 380   = mkBasicRule op_name 1 rule_fn
 381   where
 382     rule_fn [Lit l1] = test (convFloating l1)
 383     rule_fn _        = Nothing
 384
 385 twoLits :: Name -> (Literal -> Literal -> Maybe CoreExpr)
 386         -> [CoreRule]
 387 twoLits op_name test
 388   = mkBasicRule op_name 2 rule_fn
 389   where
 390     rule_fn [Lit l1, Lit l2] = test (convFloating l1) (convFloating l2)
 391     rule_fn _                = Nothing
 392
 393 -- When excess precision is not requested, cut down the precision of the
 394 -- Rational value to that of Float/Double. We confuse host architecture
 395 -- and target architecture here, but it's convenient (and wrong :-).
 396 convFloating :: Literal -> Literal
 397 convFloating (MachFloat  f) | not opt_SimplExcessPrecision =
 398    MachFloat  (toRational ((fromRational f) :: Float ))
 399 convFloating (MachDouble d) | not opt_SimplExcessPrecision =
 400    MachDouble (toRational ((fromRational d) :: Double))
 401 convFloating l = l
 402
 403 trueVal       = Var trueDataConId
 404 falseVal      = Var falseDataConId
 405 mkIntVal    i = Lit (mkMachInt  i)
 406 mkWordVal   w = Lit (mkMachWord w)
 407 mkFloatVal  f = Lit (convFloating (MachFloat  f))
 408 mkDoubleVal d = Lit (convFloating (MachDouble d))
 409 \end{code}
 410
 411
 412 %************************************************************************
 413 %*                                                                      *
 414 \subsection{Special rules for seq, tagToEnum, dataToTag}
 415 %*                                                                      *
 416 %************************************************************************
 417
 418 \begin{code}
 419 tagToEnumRule [Type ty, Lit (MachInt i)]
 420   = ASSERT( isEnumerationTyCon tycon )
 421     case filter correct_tag (tyConDataCons_maybe tycon `orElse` []) of
 422
 423
 424         []        -> Nothing    -- Abstract type
 425         (dc:rest) -> ASSERT( null rest )
 426                      Just (Var (dataConWorkId dc))
 427   where
 428     correct_tag dc = (dataConTag dc - fIRST_TAG) == tag
 429     tag   = fromInteger i
 430     tycon = tyConAppTyCon ty
 431
 432 tagToEnumRule other = Nothing
 433 \end{code}
 434
 435 For dataToTag#, we can reduce if either
 436
 437         (a) the argument is a constructor
 438         (b) the argument is a variable whose unfolding is a known constructor
 439
 440 \begin{code}
 441 dataToTagRule [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag]
 442   | tag_to_enum `hasKey` tagToEnumKey
 443   , ty1 `coreEqType` ty2
 444   = Just tag    -- dataToTag (tagToEnum x)   ==>   x
 445
 446 dataToTagRule [_, val_arg]
 447   | Just (dc,_) <- exprIsConApp_maybe val_arg
 448   = ASSERT( not (isNewTyCon (dataConTyCon dc)) )
 449     Just (mkIntVal (toInteger (dataConTag dc - fIRST_TAG)))
 450
 451 dataToTagRule other = Nothing
 452 \end{code}
 453
 454 %************************************************************************
 455 %*                                                                      *
 456 \subsection{Built in rules}
 457 %*                                                                      *
 458 %************************************************************************
 459
 460 Note [Scoping for Builtin rules]
 461 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 462 When compiling a (base-package) module that defines one of the
 463 functions mentioned in the RHS of a built-in rule, there's a danger
 464 that we'll see
 465
 466         f = ...(eq String x)....
 467
 468         ....and lower down...
 469
 470         eqString = ...
 471
 472 Then a rewrite would give
 473
 474         f = ...(eqString x)...
 475         ....and lower down...
 476         eqString = ...
 477
 478 and lo, eqString is not in scope.  This only really matters when we get to code
 479 generation.  With -O we do a GlomBinds step that does a new SCC analysis on the whole
 480 set of bindings, which sorts out the dependency.  Without -O we don't do any rule
 481 rewriting so again we are fine.
 482
 483 (This whole thing doesn't show up for non-built-in rules because their dependencies
 484 are explicit.)
 485
 486
 487 \begin{code}
 488 builtinRules :: [CoreRule]
 489 -- Rules for non-primops that can't be expressed using a RULE pragma
 490 builtinRules
 491   = [ BuiltinRule { ru_name = fsLit "AppendLitString", ru_fn = unpackCStringFoldrName,
 492                     ru_nargs = 4, ru_try = match_append_lit },
 493       BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName,
 494                     ru_nargs = 2, ru_try = match_eq_string },
 495       BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,
 496                     ru_nargs = 2, ru_try = match_inline }
 497     ]
 498
 499
 500 ---------------------------------------------------
 501 -- The rule is this:
 502 --      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)  =  unpackFoldrCString# "foobaz" c n
 503
 504 match_append_lit [Type ty1,
 505                    Lit (MachStr s1),
 506                    c1,
 507                    Var unpk `App` Type ty2
 508                             `App` Lit (MachStr s2)
 509                             `App` c2
 510                             `App` n
 511                   ]
 512   | unpk `hasKey` unpackCStringFoldrIdKey &&
 513     c1 `cheapEqExpr` c2
 514   = ASSERT( ty1 `coreEqType` ty2 )
 515     Just (Var unpk `App` Type ty1
 516                    `App` Lit (MachStr (s1 `appendFS` s2))
 517                    `App` c1
 518                    `App` n)
 519
 520 match_append_lit other = Nothing
 521
 522 ---------------------------------------------------
 523 -- The rule is this:
 524 --      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
 525
 526 match_eq_string [Var unpk1 `App` Lit (MachStr s1),
 527                  Var unpk2 `App` Lit (MachStr s2)]
 528   | unpk1 `hasKey` unpackCStringIdKey,
 529     unpk2 `hasKey` unpackCStringIdKey
 530   = Just (if s1 == s2 then trueVal else falseVal)
 531
 532 match_eq_string other = Nothing
 533
 534
 535 ---------------------------------------------------
 536 -- The rule is this:
 537 --      inline f_ty (f a b c) = <f's unfolding> a b c
 538 -- (if f has an unfolding)
 539 --
 540 -- It's important to allow the argument to 'inline' to have args itself
 541 -- (a) because its more forgiving to allow the programmer to write
 542 --       inline f a b c
 543 --   or  inline (f a b c)
 544 -- (b) because a polymorphic f wll get a type argument that the
 545 --     programmer can't avoid
 546 --
 547 -- Also, don't forget about 'inline's type argument!
 548 match_inline (Type _ : e : _)
 549   | (Var f, args1) <- collectArgs e,
 550     Just unf <- maybeUnfoldingTemplate (idUnfolding f)
 551   = Just (mkApps unf args1)
 552
 553 match_inline other = Nothing
 554 \end{code}