[Haskell-cafe] Usage of rewrite rule specialization in Hackage

Thu May 5 19:42:26 CEST 2011

On Thu, May 5, 2011 at 10:36 AM, Scott Kilpatrick <skilpat at mpi-sws.org> wrote:
> I'm looking for "real" code that uses the kind of GHC rewrite rule
> that specializes a polymorphic function with another one, as described
> here <http://www.haskell.org/ghc/docs/latest/html/users_guide/rewrite-
> rules.html#rule-spec>.  Can anyone point me to any popular packages in
> Hackage that make use of this?

I can't or rather won't go so far as point out specific Hackage
packages. What I can give you is the output of grepping my 111k
corpus, which resulted in 744 hits for RULES.

Attached is the output of `find ~/bin -name "*.lhs" -exec grep -l "{-#
RULES " {} \; -exec grep --after-context=3 "{-# RULES " {} \;`. Sample
output:

/home/gwern/bin/jaspervdj/blaze-builder/benchmarks/LazyByteString.hs
{-# RULES "fromWriteReplicated/writeWord8"
      fromWriteReplicated writeWord8 = fromReplicateWord8
 #-}

/home/gwern/bin/bloomfilter/Data/BloomFilter.hs
{-# RULES "Bloom insertB . insertB" forall a b u.
    insertB b (insertB a u) = insertListB [a,b] u
  #-}
{-# RULES "Bloom insertListB . insertB" forall x xs u.
    insertListB xs (insertB x u) = insertListB (x:xs) u
  #-}
{-# RULES "Bloom insertB . insertListB" forall x xs u.
    insertB x (insertListB xs u) = insertListB (x:xs) u
  #-}
{-# RULES "Bloom insertListB . insertListB" forall xs ys u.
    insertListB xs (insertListB ys u) = insertListB (xs++ys) u
  #-}
{-# RULES "Bloom insertListB . emptyB" forall h n xs.
    insertListB xs (emptyB h n) = fromListB h n xs
  #-}
{-# RULES "Bloom insertListB . singletonB" forall h n x xs.
    insertListB xs (singletonB h n x) = fromListB h n (x:xs)
  #-}

/home/gwern/bin/batterseapower/haskell-kata/DeforestFree.hs
{-# RULES "reify/interpret" forall xs. interpret (reify xs) = xs #-}

/home/gwern/bin/altaic/testsuite/tests/ghc-regress/simplCore/should_run/simplrun002.hs
{-# RULES "foo" forall v .  fst (sndSnd v) = trace "Yes" (fst v) #-}
main :: IO ()
main = print (fst (sndSnd (True, (False,True))))

-- 
gwern
http://www.gwern.net
-------------- next part --------------
/home/gwern/bin/JakeWheat/hssqlppp/examples/util/Database/HsSqlPpp/Utils/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/martine/h8/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/jaspervdj/blaze-builder/benchmarks/LazyByteString.hs
{-# RULES "fromWriteReplicated/writeWord8"
      fromWriteReplicated writeWord8 = fromReplicateWord8
 #-}

/home/gwern/bin/arsenm/Clutterhs/cogl/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/arsenm/Clutterhs/clutter/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/arsenm/Clutterhs/clutter-gtk/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/arsenm/Clutterhs/clutter-gst/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/ghc/libraries/array/Data/Array/Base.hs
--   {-# RULES listArray = listUArray
-- Then we could call listUArray at any type 'e' that had a suitable
-- MArray instance.  But sadly we can't, because we don't have quantified 
-- constraints.  Hence the mass of rules below.
--
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}

-----------------------------------------------------------------------------
-- Showing IArrays
/home/gwern/bin/ghc/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}

trueName, falseName :: Name
/home/gwern/bin/fallen-s4e/GPS-stream/sandbox/2/Relations/Queue.hs
{-# RULES "qunion/Seq" qunion = (Seq.><) #-}

flattenQ :: (Queue f, Foldable f) =>
            f (f a) -> f a
/home/gwern/bin/luna/misc/Interact.hs
  | RuleD (RuleDecl id)                 {-# RULES ...
  | SpliceD (SpliceDecl id)             $(...)
  | DocD (DocDecl id)
-}
/home/gwern/bin/luna/_darcs/pristine/misc/Interact.hs
  | RuleD (RuleDecl id)                 {-# RULES ...
  | SpliceD (SpliceDecl id)             $(...)
  | DocD (DocDecl id)
-}
/home/gwern/bin/categories/src/Control/Category/Groupoid.hs
{-# RULES 
	"inv/inv" inv . inv = id
 #-}
/home/gwern/bin/categories/src/Control/Category/Bifunctor/Braided.hs
{-# RULES 
	"idr/braid" 			idr . braid = idl
	"idl/braid" 			idl . braid = idr
	"braid/coidr" 			braid . coidr = coidl
/home/gwern/bin/gitpan/Language-Haskell/hugs98-Nov2003/fptools/libraries/base/Data/Array/Base.hs
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}

-----------------------------------------------------------------------------
-- Showing IArrays
/home/gwern/bin/gitpan/Language-Haskell/hugs98-Nov2003/fptools/libraries/haskell-src/Language/Haskell/TH/THSyntax.hs
{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}

trueName, falseName :: Name
/home/gwern/bin/pepeiborra/narradar/src/Narradar/Types/Problem/InitialGoal.hs
{-# RULES "Set fromList/toList" forall x. Set.fromList(Set.toList x) = x #-}

initialPairs :: Unify t => Problem (InitialGoal t base) trs -> [Rule t Var]
initialPairs InitialGoalProblem{..} = dinitialPairs dgraph
/home/gwern/bin/pepeiborra/term/Data/Term/Annotated/Rules.hs
{-# RULES "rules/tRS" forall x. tRS (rules x) = x #-}
{-# RULES "tRS/rules" forall x. rules (tRS x) = x #-}

class HasRules ann t v trs | trs -> ann t v where rules :: trs -> [Rule ann t v]
class HasRules ann t v trs => IsTRS ann t v trs | trs -> ann t v where tRS :: [Rule ann t v] -> trs
/home/gwern/bin/pepeiborra/term/Data/Term/Rules.hs
{-# RULES "rules/tRS" forall x. tRS (rules x) = x #-}
{-# RULES "tRS/rules" forall x. rules (tRS x) = x #-}

class HasRules t v trs | trs -> t v where rules :: trs -> [Rule t v]
class HasRules t v trs => IsTRS t v trs | trs -> t v where tRS :: [Rule t v] -> trs
/home/gwern/bin/acowley/HOpenCV/src/AI/CV/OpenCV/Threshold.hs
{-# RULES 
"thresholdBinary/in-place" [~1] forall th mv.
  thresholdBinary th mv = pipeline (unsafeThreshBin th mv)
"thresholdBinary/unpipe" [1] forall th mv.
--
{-# RULES 
"thresholdTruncate/in-place" [~1] forall th. 
  thresholdTruncate th = pipeline (unsafeThreshTrunc th)
"thresholdTruncate/unpipe" [1] forall th.
--
{-# RULES 
"thresholdToZero/in-place" [~1] forall th. 
  thresholdToZero th = pipeline (unsafeThresholdToZero th)
"thresholdToZero/unpipe" [1] forall th.
--
{-# RULES 
"thresholdBinaryOtsu/in-place" [~1] forall mv. 
  thresholdBinaryOtsu mv = pipeline (unsafeBinOtsu mv)
"thresholdBinaryOtsu/unpipe" [1] forall mv.
--
{-# RULES 
"thresholdTruncateOtsu/in-place" [~1] 
  thresholdTruncateOtsu = pipeline unsafeTruncOtsu
"thresholdTruncateOtsu/unpipe" [1]
--
{-# RULES 
"thresholdToZeroOtsu/in-place" [~1]
  thresholdToZeroOtsu = pipeline unsafeToZeroOtsu
"thresholdToZeroOtsu/unpipe" [1]
/home/gwern/bin/acowley/HOpenCV/src/AI/CV/OpenCV/ArrayOps.hs
{-# RULES 
"subRS/in-place" [~1] forall v. subRS v = pipeline (unsafeSubRS v)
"subRS/unpipe" [1] forall v. pipeline (unsafeSubRS v) = subRS v
  #-}
--
{-# RULES 
"absDiff/in-place" [~1] forall m. absDiff m = pipeline (unsafeAbsDiff m)
"absDiff/unpipe" [1] forall m. pipeline (unsafeAbsDiff m) = absDiff m
  #-}
--
{-# RULES 
"cvAnd/in-place" [~1] forall s. cvAnd s = pipeline (unsafeAnd s)
"cvAnd/unpipe" [1] forall s. pipeline (unsafeAnd s) = cvAnd s
"cvAndMask/in-place" [~1] forall m s. 
--
{-# RULES 
"cvAndS/in-place" [~1] forall s. cvAndS s = pipeline (unsafeAndS s)
"cvAndS/unpipe" [1] forall s. pipeline (unsafeAndS s) = cvAndS s
  #-}
--
{-# RULES 
"cvMul/in-place" [~1] forall s1. cvMul s1 = pipeline (unsafeMul s1)
"cvMul/unpipe" [1] forall s1. pipeline (unsafeMul s1) = cvMul s1
"cvMul'/in-place" [~1] forall s s1. cvMul' s s1 = pipeline (unsafeMul' s s1)
/home/gwern/bin/acowley/HOpenCV/src/AI/CV/OpenCV/HighCV.hs
{-# RULES 
"erode/in-place" [~1] forall n. erode n = pipeline (unsafeErode n)
"erode/unpipe" [1] forall n. pipeline (unsafeErode n) = erode n
"dilate/in-place" [~1] forall n. dilate n = pipeline (unsafeDilate n)
--
{-# RULES 
"drawLines/in-place" [~1] forall c t lt lns. 
  drawLines c t lt lns = pipeline (unsafeDrawLines c t lt lns)
"drawLines/unpipe" [1] forall c t lt lns.
--
{-# RULES 
"canny/in-place" [~1] forall t1 t2 a.
  cannyEdges t1 t2 a = pipeline (unsafeCanny t1 t2 a)
"canny/unpipe" [1] forall t1 t2 a.
/home/gwern/bin/sw17ch/portaudio/oldsrc/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/tobbebex/GPipe/src/Shader.hs
{-# RULES "norm/F4" norm = normF4 #-}
{-# RULES "norm/F3" norm = normF3 #-}
{-# RULES "norm/F2" norm = normF2 #-}
normF4 :: Vec4 (Fragment Float) -> Fragment Float
normF4 = fUnaryFunc "float" "length" . fFromVec "vec4"
normF3 :: Vec3 (Fragment Float) -> Fragment Float
--
{-# RULES "norm/V4" norm = normV4 #-}
{-# RULES "norm/V3" norm = normV3 #-}
{-# RULES "norm/V2" norm = normV2 #-}
normV4 :: Vec4 (Vertex Float) -> Vertex Float
normV4 = vUnaryFunc "float" "length" . vFromVec "vec4"
normV3 :: Vec3 (Vertex Float) -> Vertex Float
--
{-# RULES "normalize/F4" normalize = normalizeF4 #-}
{-# RULES "normalize/F3" normalize = normalizeF3 #-}
{-# RULES "normalize/F2" normalize = normalizeF2 #-}
normalizeF4 :: Vec4 (Fragment Float) -> Vec4 (Fragment Float)
normalizeF4 = fToVec "float" 4 . fUnaryFunc "vec4" "normalize" . fFromVec "vec4"
normalizeF3 :: Vec3 (Fragment Float) -> Vec3 (Fragment Float)
--
{-# RULES "normalize/V4" normalize = normalizeV4 #-}
{-# RULES "normalize/V3" normalize = normalizeV3 #-}
{-# RULES "normalize/V2" normalize = normalizeV2 #-}
normalizeV4 :: Vec4 (Vertex Float) -> Vec4 (Vertex Float)
normalizeV4 = vToVec "float" 4 . vUnaryFunc "vec4" "normalize" . vFromVec "vec4"
normalizeV3 :: Vec3 (Vertex Float) -> Vec3 (Vertex Float)
--
{-# RULES "dot/F4" dot = dotF4 #-}
{-# RULES "dot/F3" dot = dotF3 #-}
{-# RULES "dot/F2" dot = dotF2 #-}
dotF4 :: Vec4 (Fragment Float) -> Vec4 (Fragment Float) -> Fragment Float
dotF4 a b = fBinaryFunc "float" "dot" (fFromVec "vec4" a) (fFromVec "vec4" b)
dotF3 :: Vec3 (Fragment Float) -> Vec3 (Fragment Float) -> Fragment Float
--
{-# RULES "dot/V4" dot = dotV4 #-}
{-# RULES "dot/V3" dot = dotV3 #-}
{-# RULES "dot/V2" dot = dotV2 #-}
dotV4 :: Vec4 (Vertex Float) -> Vec4 (Vertex Float) -> Vertex Float
dotV4 a b = vBinaryFunc "float" "dot" (vFromVec "vec4" a) (vFromVec "vec4" b)
dotV3 :: Vec3 (Vertex Float) -> Vec3 (Vertex Float) -> Vertex Float
--
{-# RULES "cross/F3" cross = crossF3 #-}
crossF3 :: Vec3 (Fragment Float) -> Vec3 (Fragment Float) -> Vec3 (Fragment Float)
crossF3 a b = fToVec "float" 3 $ fBinaryFunc "vec3" "cross" (fFromVec "vec3" a) (fFromVec "vec3" b)
{-# RULES "cross/V3" cross = crossV3 #-}
crossV3 :: Vec3 (Vertex Float) -> Vec3 (Vertex Float) ->Vec3 (Vertex Float)
crossV3 a b = vToVec "float" 3 $ vBinaryFunc "vec3" "cross" (vFromVec "vec3" a) (vFromVec "vec3" b)

/home/gwern/bin/bloomfilter/Data/BloomFilter.hs
{-# RULES "Bloom insertB . insertB" forall a b u.
    insertB b (insertB a u) = insertListB [a,b] u
  #-}

{-# RULES "Bloom insertListB . insertB" forall x xs u.
    insertListB xs (insertB x u) = insertListB (x:xs) u
  #-}

{-# RULES "Bloom insertB . insertListB" forall x xs u.
    insertB x (insertListB xs u) = insertListB (x:xs) u
  #-}

{-# RULES "Bloom insertListB . insertListB" forall xs ys u.
    insertListB xs (insertListB ys u) = insertListB (xs++ys) u
  #-}

{-# RULES "Bloom insertListB . emptyB" forall h n xs.
    insertListB xs (emptyB h n) = fromListB h n xs
  #-}

{-# RULES "Bloom insertListB . singletonB" forall h n x xs.
    insertListB xs (singletonB h n x) = fromListB h n (x:xs)
  #-}

--
{-# RULES "Bloom insertListB . fromListB" forall h n xs ys.
    insertListB xs (fromListB h n ys) = fromListB h n (xs ++ ys)
  #-}

/home/gwern/bin/dterei/GhcDevFiles/hs/safe/rules/d.hs
{-# RULES "lookupx/T" lookupx = tLookup #-}
tLookup :: [(T,a)] -> T -> Maybe a
tLookup [] _                      = Nothing
tLookup ((t,a):xs) t' | t /= t'   = Just a
/home/gwern/bin/hsndfile/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/batterseapower/haskell-kata/DeforestFree.hs
{-# RULES "reify/interpret" forall xs. interpret (reify xs) = xs #-}

{-# INLINE mapL #-}
/home/gwern/bin/batterseapower/graph-wrapper/Data/Graph/Wrapper/Internal.hs
{-# RULES "indexGVertex/gVertexIndex" forall g i. gVertexIndex g (indexGVertex g i) = i #-}
{-# RULES "gVertexIndex/indexGVertex" forall g v. indexGVertex g (gVertexIndex g v) = v #-}

{-# NOINLINE [0] indexGVertex #-}
indexGVertex :: Ord i => Graph i v -> i -> G.Vertex
/home/gwern/bin/meiersi/blaze-builder/benchmarks/LazyByteString.hs
{-# RULES "fromWriteReplicated/writeWord8"
      fromWriteReplicated writeWord8 = fromReplicateWord8
 #-}

/home/gwern/bin/meiersi/text/Data/Text/Fusion/Common.hs
{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

-- ----------------------------------------------------------------------------
-- * Basic stream functions
/home/gwern/bin/meiersi/text/Data/Text/Encoding.hs
{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
    forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

-- | Decode a 'ByteString' containing UTF-8 encoded text..
/home/gwern/bin/meiersi/text/Data/Text/Fusion.hs
{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

-- ----------------------------------------------------------------------------
/home/gwern/bin/meiersi/text/Data/Text/Lazy/Fusion.hs
{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
    stream (unstream s) = s #-}

-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
/home/gwern/bin/meiersi/bytestring/Data/ByteString/Builder/Unsafe.hs
{-# RULES "fromWriteReplicated/writeWord8"
      fromWriteReplicated writeWord8 = fromReplicateWord8
 #-}

/home/gwern/bin/lhc/lib/array-0.2.0.0/Data/Array/Base.hs
--   {-# RULES listArray = listUArray
-- Then we could call listUArray at any type 'e' that had a suitable
-- MArray instance.  But sadly we can't, because we don't have quantified 
-- constraints.  Hence the mass of rules below.
--
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}

-----------------------------------------------------------------------------
-- Showing IArrays
/home/gwern/bin/eamsden/Animas/src/FRP/Animas.hs
{-# RULES "arrPrim/arrEPrim" arrPrim = arrEPrim #-}
-- | Lifts a function with an event input to a pure signal function
-- on events. Use 'arr' from the 'Arrow' class, rather than this function.
arrEPrim :: (Event a -> b) -> SF (Event a) b
/home/gwern/bin/andygill/chalkboard/core/Graphics/Chalkboard/Utils.hs
{-# RULES "distance <= w" forall t u w . distance t u <= w = distanceLe t u w #-}
{-# INLINE distanceLe #-}
distanceLe :: Point -> Point -> R -> Bool
distanceLe (x,y) (x',y') w = (xd * xd + yd * yd) <= w * w
/home/gwern/bin/kaoskorobase/hsndfile/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/kaoskorobase/mescaline/resources/hugs/packages/base/Data/Array/Base.hs
--   {-# RULES listArray = listUArray
-- Then we could call listUArray at any type 'e' that had a suitable
-- MArray instance.  But sadly we can't, because we don't have quantified 
-- constraints.  Hence the mass of rules below.
--
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}

-----------------------------------------------------------------------------
-- Showing IArrays
/home/gwern/bin/dmpots/lhc/lib/array-0.2.0.0/Data/Array/Base.hs
--   {-# RULES listArray = listUArray
-- Then we could call listUArray at any type 'e' that had a suitable
-- MArray instance.  But sadly we can't, because we don't have quantified 
-- constraints.  Hence the mass of rules below.
--
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}

-----------------------------------------------------------------------------
-- Showing IArrays
/home/gwern/bin/dmpots/lambdachine/tests/integer-gmp/GHC/Integer.hs
{-# RULES "toInt#" forall i. toInt# (S# i) = i #-}
toInt# (S# i)   = i
toInt# (J# s d) = 0#  -- XXX: for now
/home/gwern/bin/patperry/hs-monte-carlo/lib/Control/Monad/MC/Sample.hs
{-# RULES "sampleHelp/Double" forall n xs f.
              sampleHelp n (xs :: [Double]) f = sampleHelpU n xs f #-}
{-# RULES "sampleHelp/Int" forall n xs f.
              sampleHelp n (xs :: [Int]) f = sampleHelpU n xs f #-}

sampleListHelp :: (Monad m) => Int -> [a] -> m [Int] -> m [a]
--
{-# RULES "sampleListHelp/Double" forall n xs f.
              sampleListHelp n (xs :: [Double]) f = sampleListHelpU n xs f #-}
{-# RULES "sampleListHelp/Int" forall n xs f.
              sampleListHelp n (xs :: [Int]) f = sampleListHelpU n xs f #-}

-- | @sampleInt n@ samples integers uniformly from @[ 0..n-1 ]@.  It is an
--
{-# RULES "shuffle/Double" forall xs.
              shuffle (xs :: [Double]) = shuffleU xs #-}
{-# RULES "shuffle/Int" forall xs.
              shuffle (xs :: [Int]) = shuffleU xs #-}

/home/gwern/bin/arrayref/Data/ArrayBZ/Internals/IArray.hs
{-# RULES "cmpIArray/Int" cmpIArray = cmpIntIArray #-}

/home/gwern/bin/arrayref/Data/ArrayBZ/Internals/unused.hs
--   {-# RULES listArray = listUArray
-- Then we could call listUArray at any type 'e' that had a suitable
-- MArray instance.  But sadly we can't, because we don't have quantified
-- constraints.  Hence the mass of rules below.
/home/gwern/bin/igel2/red-blue-stack/Data/RedBlueStack.hs
{-# RULES "recolour/recolour" forall s. recolour (recolour s) = s #-}

-- | /O(n)/. Reverse the order of elements.
reverse :: RedBlueStack r b -> RedBlueStack r b
/home/gwern/bin/igel2/heap/Data/Heap/Item.hs
{-# RULES "split/merge" forall x. split (merge x) = x #-}

-- | Policy type for a 'MinHeap'.
data MinPolicy
--
{-# RULES "splitF/split" forall f x. splitF f (split x) = f x #-}
/home/gwern/bin/adept/haskell-mpi/src/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/bjpop/haskell-mpi/src/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/nominolo/lambdachine/tests/integer-gmp/GHC/Integer.hs
{-# RULES "toInt#" forall i. toInt# (S# i) = i #-}
toInt# (S# i)   = i
toInt# (J# s d) = 0#  -- XXX: for now
/home/gwern/bin/portaudio/src/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/portaudio/_darcs/pristine/src/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/ginsu/GenUtil.hs
{-# RULES "snub/snub" forall x . snub (snub x) = snub x #-}
{-# RULES "snub/nub" forall x . snub (nub x) = snub x #-}
{-# RULES "nub/snub" forall x . nub (snub x) = snub x #-}
{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}
{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}
{-# RULES "snub/[]" snub [] = [] #-}
{-# RULES "snub/[x]" forall x . snub [x] = [x] #-}

-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub :: Ord a => [a] -> [a]
--
{-# RULES "replicateM/0" replicateM 0 = const (return []) #-}
{-# RULES "replicateM_/0" replicateM_ 0 = const (return ()) #-}

{-# INLINE replicateM #-}
{-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-}
/home/gwern/bin/ginsu/_darcs/pristine/GenUtil.hs
{-# RULES "snub/snub" forall x . snub (snub x) = snub x #-}
{-# RULES "snub/nub" forall x . snub (nub x) = snub x #-}
{-# RULES "nub/snub" forall x . nub (snub x) = snub x #-}
{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}
{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}
{-# RULES "snub/[]" snub [] = [] #-}
{-# RULES "snub/[x]" forall x . snub [x] = [x] #-}

-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub :: Ord a => [a] -> [a]
--
{-# RULES "replicateM/0" replicateM 0 = const (return []) #-}
{-# RULES "replicateM_/0" replicateM_ 0 = const (return ()) #-}

{-# INLINE replicateM #-}
{-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-}
/home/gwern/bin/jhc/src/GenUtil.hs
{-# RULES "snub/snub" forall x . snub (snub x) = snub x #-}
{-# RULES "snub/nub" forall x . snub (nub x) = snub x #-}
{-# RULES "nub/snub" forall x . nub (snub x) = snub x #-}
{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}
{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}
{-# RULES "snub/[]" snub [] = [] #-}
{-# RULES "snub/[x]" forall x . snub [x] = [x] #-}

-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub :: Ord a => [a] -> [a]
--
{-# RULES "replicateM/0" replicateM 0 = const (return []) #-}
{-# RULES "replicateM_/0" replicateM_ 0 = const (return ()) #-}

{-# INLINE replicateM #-}
{-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-}
/home/gwern/bin/jhc/src/FrontEnd/HsPretty.hs
--ppHsDecl prules at HsPragmaRules {} = text ("{-# RULES " ++ show (hsDeclString prules)) <+> text "forall" <+> vars <+> text "." $$ nest 4 rest $$ text "#-}" where
--    vars = hsep (map ppHsTName $ hsDeclFreeVars prules)
--    rest = ppHsExp (hsDeclLeftExpr prules) <+> text "=" <+> ppHsExp (hsDeclRightExpr prules)
ppHsDecl prules at HsPragmaSpecialize {} = text "{-# SPECIALIZE ... #-}" --  ++ show (hsDeclString prules)) <+> text "forall" <+> vars <+> text "." $$ nest 4 rest $$ text "#-}" where
/home/gwern/bin/jhc/lib/base/Data/List.hs
{-# RULES "sort/sort"  forall  xs . sort (sort xs) = sort xs #-}
{-# RULES "nub/nub"  forall  xs . nub (nub xs) = nub xs #-}

-- | A strict version of 'foldl'.
/home/gwern/bin/jhc/lib/jhc/Jhc/Monad.hs
{-# RULES "sequence/[]"   sequence [] = return [] #-}
{-# RULES "sequence_/[]"  sequence_ [] = return () #-}
{-# RULES "mapM/[]"       forall f . mapM f [] = return [] #-}
{-# RULES "mapM_/[]"      forall f . mapM_ f [] = return () #-}
{-# RULES "sequence_/++"  forall xs ys . sequence_ (xs ++ ys) = sequence_ xs >> sequence_ ys #-}
{-# RULES "mapM_/++"      forall xs ys f . mapM_ f (xs ++ ys) = mapM_ f xs >> mapM_ f ys #-}

mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f as = go as where
/home/gwern/bin/jhc/lib/jhc/Jhc/List.hs
{-# RULES "foldr/nil" forall k z.   foldr k z []  = z  #-}
{-# RULES "foldr/single"  forall k z x . foldr k z [x] = k x z #-}
{-# RULES "foldr/double"  forall k z x y . foldr k z [x,y] = k x (k y z) #-}
{-# RULES "foldr/triple"  forall k z a b c . foldr k z [a,b,c] = k a (k b (k c z)) #-}
{-# RULES "foldr/id"      foldr (:) [] = \x -> x  #-}
{- "foldr/app"    	[1] forall ys. foldr (:) ys = \xs -> xs ++ ys -}

{-# RULES "foldr/build" forall k z (g :: forall b . (a -> b -> b) -> b -> b) . foldr k z (build g) = g k z #-}
{-# RULES "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .  foldr k z (augment g xs) = g k (foldr k z xs) #-}
{-# RULES "foldr/single" forall k z x. foldr k z [x] = k x z #-}
{-# RULES "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
		       (h::forall b. (a->b->b) -> b -> b) .
		       augment g (build h) = build (\c n -> g c (h c n)) #-}
{-# RULES "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .  augment g [] = build g #-}

{-# RULES "foldr/unpackString"  forall k z (addr::Addr__) . foldr k z (unpackString addr) = unpackStringFoldr addr k z  #-}

-- a few pre-fusioned routines

--
{-# RULES "tail/map"      forall f xs . tail (map f xs) = map f (tail xs) #-}
{-# RULES "head/map"      forall f xs . head (map f xs) = f (head xs) #-}
{-# RULES "head/:"        forall x xs . head (x:xs) = x #-}
{-# RULES "tail/:"        forall x xs . tail (x:xs) = xs #-}

{-# RULES "filter/iterate" forall p f x . filter p (iterate f x) = filterIterate p f x  #-}
{-# RULES "map/iterate" forall f g x . map f (iterate g x) = mapIterate f g x  #-}
{-# RULES "map/filter" forall f p xs . map f (filter p xs) = mapFilter f p xs  #-}
{-# RULES "filter/map" forall f p xs . filter p (map f xs) = filterMap p f xs  #-}

-- efficient implementations of prelude routines

--
{-# RULES "any/build"     forall p (g::forall b.(a->b->b)->b->b) .  any p (build g) = g ((||) . p) False #-}

{-# RULES "all/build"     forall p (g::forall b.(a->b->b)->b->b) .  all p (build g) = g ((&&) . p) True #-}

any, all         :: (a -> Bool) -> [a] -> Bool
--
{-# RULES "elem/[]" forall c . elem c [] = False #-}
{-# RULES "elem/[_]" forall c v . elem c [v] = c == v #-}

notElem	_ []	=  True
notElem x (y:ys)
--
{-# RULES "notElem/[]" forall c . notElem c [] = True #-}
{-# RULES "notElem/[_]" forall c v . notElem c [v] = c /= v #-}

infixl 9  !!

--
{-# RULES "head/iterate"  forall f x . head (iterate f x) = x #-}
{-# RULES "head/repeat"   forall x . head (repeat x) = x #-}
{-# RULES "tail/repeat"   forall x . tail (repeat x) = repeat x #-}
{-# RULES "tail/iterate"  forall f x . tail (iterate f x) = iterate f (f x) #-}
{-# RULES "iterate/id" forall . iterate id = repeat #-}

--
{-# RULES "head/build"   forall (g::forall b.(a->b->b)->b->b) . head (build g) = g (\x _ -> x) badHead #-}

{-# RULES "head/augment"   forall xs (g::forall b. (a->b->b) -> b -> b) .  head (augment g xs) = g (\x _ -> x) (head xs) #-}

--repeat x = build (\c _n -> repeatFB c x)
--repeatFB c x = xs where xs = x `c` xs
--
{-# RULES forall xs n (g :: forall b . (a -> b -> b) -> b -> b) . build g !! n  = bangBang g n  #-}

bangBang :: (forall b . (a -> b -> b) -> b -> b) -> Int -> a
g `bangBang` n
/home/gwern/bin/jhc/lib/jhc/Prelude/IO.hs
{-# RULES "putStr/++"      forall xs ys . putStr (xs ++ ys) = putStr xs >> putStr ys #-}

putStr     :: String -> IO ()
putStr s   =  mapM_ putChar s
/home/gwern/bin/jhc/lib/jhc/Prelude.hs
{-# RULES "sum/Int" forall . sum = sum' :: [Int] -> Int #-}
{-# SPECIALIZE sum' :: [Double] -> Double #-}
{-# RULES "sum/Double" forall . sum = sum' :: [Double] -> Double #-}

-- maximum and minimum return the maximum or minimum value from a list,
-- which must be non-empty, finite, and of an ordered type.
--
{-# RULES "drop/0"        forall . drop 0 = \xs -> xs #-}
{-# RULES "drop/1"        forall x xs . drop 1 (x:xs) = xs #-}
{-# RULES "drop/2"        forall x y xs . drop 2 (x:y:xs) = xs #-}
{-# RULES "drop/3"        forall x y z xs . drop 3 (x:y:z:xs) = xs #-}
{-# RULES "take/0"        forall xs . take 0 xs = [] #-}
{-# RULES "take/1"        forall x xs . take 1 (x:xs) = [x] #-}
{-# RULES "take/2"        forall x y xs . take 2 (x:y:xs) = [x,y] #-}
{-# RULES "take/3"        forall x y z xs . take 3 (x:y:z:xs) = [x,y,z] #-}
{-# RULES "!!/0"          forall x xs . (x:xs) !! 0 = x #-}
{-# RULES "!!/1"          forall x y xs . (x:y:xs) !! 1 = y #-}
{-# RULES "!!/2"          forall x y z xs . (x:y:z:xs) !! 2 = z #-}
{-# RULES "concat/Map"    forall f xs . concat (map f xs) = concatMap f xs #-}
{-# RULES "sequence/map"  forall f xs . sequence (map f xs) = mapM f xs #-}
{-# RULES "sequence_/map" forall f xs . sequence_ (map f xs) = mapM_ f xs #-}
{-# RULES "++/emptyr"     forall xs . xs ++ [] = xs #-}
{-# RULES "++/refix"      forall xs ys zs . (xs ++ ys) ++ zs = xs ++ (ys ++ zs) #-}
--{-# RULES "++/tick4"      forall x y z x' xs ys . (x:y:z:x':xs) ++ ys = x:y:z:x':(xs ++ ys) #-}
--{-# RULES "++/tick2"      forall x y xs ys . (x:y:xs) ++ ys = x:y:(xs ++ ys) #-}
--{-# RULES "++/tick1"      forall x xs ys . (x:xs) ++ ys = x:(xs ++ ys) #-}
{-# RULES "++/tick0"      forall xs . [] ++ xs = xs #-}
{-# RULES "++/tick1"      forall x xs . [x] ++ xs = x:xs #-}
{-# RULES "++/tick2"      forall x y xs . [x,y] ++ xs = x:y:xs #-}
{-# RULES "++/tick3"      forall x y z xs . [x,y,z] ++ xs = x:y:z:xs #-}
{-# RULES "map/map"       forall f g xs . map f (map g xs) = map (\x -> f (g x)) xs #-}
{-# RULES "concatMap/map" forall f g xs . concatMap f (map g xs) = concatMap (\x -> f (g x)) xs #-}
{---# RULES "concat/tick"   forall x xs . concat (x:xs) = x ++ concat xs #-}
{-# RULES "concat/[]"     concat [] = [] #-}
{-# RULES "map/[]"        forall f . map f [] = [] #-}
{-# RULES "concatMap/[]"  forall f . concatMap f [] = [] #-}
{-# RULES "concatMap/++"  forall xs ys f . concatMap f (xs ++ ys) = concatMap f xs ++ concatMap f ys #-}
{-# RULES "map/++"        forall xs ys f . map f (xs ++ ys) = map f xs ++ map f ys #-}

{-# RULES "foldr/map" forall k z f xs . foldr k z (map f xs) = foldr (\x y -> k (f x) y) z xs #-}
{-# RULES "foldr/concatMap" forall k z f xs . foldr k z (concatMap f xs) = foldr (\x y -> foldr k (f x) y) z xs #-}
{-# RULES "foldr/filter" forall k z f xs . foldr k z (filter f xs) = foldr (\x y -> if f x then k x y else y) z xs #-}
{-# RULES "foldr/++" forall k z xs ys . foldr k z (xs ++ ys) = foldr k (foldr k z ys) xs #-}
{-# RULES "foldr/concat" forall k z xs . foldr k z (concat xs) = foldr (\x y -> foldr k y x) z xs #-}
{-# RULES "foldr/repeat" forall k _z x . foldr k _z (repeat x) = let r = k x r in r #-}
-- causes horrible code bloat
-- {-# RULES "foldr/x:xs" forall k z x xs . foldr k z (x:xs) = k x (foldr k z xs) #-}
{-# RULES "foldr/zip" forall k z xs ys . foldr k z (zip xs ys) = let zip' (a:as) (b:bs) = k (a,b) (zip' as bs); zip' _ _ = z in zip' xs ys #-}
-- {-# RULES "foldr/sequence" forall k z xs . foldr k z (sequence xs) = foldr (\x y -> do rx <- x; ry <- y; return (k rx ry)) (return z) xs #-}
-- {-# RULES "foldr/mapM" forall k z f xs . foldr k z (mapM f xs) = foldr (\x y -> do rx <- f x; ry <- y; return (k rx ry)) (return z) xs   #-}
{-# RULES "take/repeat"   forall n x . take n (repeat x) = replicate n x #-}

default(Int,Double)
/home/gwern/bin/jhc/regress/tests/1_typecheck/2_pass/ghc/T3346.hs
{-# RULES "rule1"   forall x. to (from x) = x #-}
{-# RULES "rule2"   forall x. from (to x) = x #-}

foo :: EP a => a -> a
-- This is typed in a way rather similarly to RULE rule1
/home/gwern/bin/jhc/regress/tests/1_typecheck/2_pass/ghc/T2497.hs
{-# RULES "id" forall (x :: a). id x = x #-}

/home/gwern/bin/markwright/antlrc/src/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/tibbe/text/Data/Text/Fusion/Common.hs
{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

-- ----------------------------------------------------------------------------
-- * Basic stream functions
/home/gwern/bin/tibbe/text/Data/Text/Encoding.hs
{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
    forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

-- | Encode text using UTF-8 encoding.
/home/gwern/bin/tibbe/text/Data/Text/Fusion.hs
{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

-- ----------------------------------------------------------------------------
/home/gwern/bin/tibbe/text/Data/Text/Lazy/Fusion.hs
{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
    stream (unstream s) = s #-}

-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
/home/gwern/bin/droundy/franchise/Distribution/Franchise/CharAssocList.hs
{-# RULES "fromListC . toListC"
  forall x. fromListC (toListC x) = x #-}

toListC :: CharAssocList a -> [(Char, a)]
/home/gwern/bin/droundy/franchise/Distribution/Franchise/Trie.hs
{-# RULES "fromListT . toListT"
  forall x. fromListT (toListT x) = x #-}

toListT :: Trie a -> [(String, a)]
/home/gwern/bin/droundy/franchise/Distribution/Franchise/StringSet.hs
{-# RULES "fromListS . toListS"
  forall x. fromListS (toListS x) = x #-}

toListS :: StringSet -> [String]
/home/gwern/bin/krasin/nacl-jhc/src/GenUtil.hs
{-# RULES "snub/snub" forall x . snub (snub x) = snub x #-}
{-# RULES "snub/nub" forall x . snub (nub x) = snub x #-}
{-# RULES "nub/snub" forall x . nub (snub x) = snub x #-}
{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}
{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}
{-# RULES "snub/[]" snub [] = [] #-}
{-# RULES "snub/[x]" forall x . snub [x] = [x] #-}

-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub :: Ord a => [a] -> [a]
--
{-# RULES "replicateM/0" replicateM 0 = const (return []) #-}
{-# RULES "replicateM_/0" replicateM_ 0 = const (return ()) #-}

{-# INLINE replicateM #-}
{-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-}
/home/gwern/bin/krasin/nacl-jhc/src/FrontEnd/HsPretty.hs
--ppHsDecl prules at HsPragmaRules {} = text ("{-# RULES " ++ show (hsDeclString prules)) <+> text "forall" <+> vars <+> text "." $$ nest 4 rest $$ text "#-}" where
--    vars = hsep (map ppHsTName $ hsDeclFreeVars prules)
--    rest = ppHsExp (hsDeclLeftExpr prules) <+> text "=" <+> ppHsExp (hsDeclRightExpr prules)
ppHsDecl prules at HsPragmaSpecialize {} = text "{-# SPECIALIZE ... #-}" --  ++ show (hsDeclString prules)) <+> text "forall" <+> vars <+> text "." $$ nest 4 rest $$ text "#-}" where
/home/gwern/bin/krasin/nacl-jhc/lib/base/Data/List.hs
{-# RULES "sort/sort"  forall  xs . sort (sort xs) = sort xs #-}
{-# RULES "nub/nub"  forall  xs . nub (nub xs) = nub xs #-}

-- | A strict version of 'foldl'.
/home/gwern/bin/krasin/nacl-jhc/lib/jhc/Jhc/Monad.hs
{-# RULES "sequence/[]"   sequence [] = return [] #-}
{-# RULES "sequence_/[]"  sequence_ [] = return () #-}
{-# RULES "mapM/[]"       forall f . mapM f [] = return [] #-}
{-# RULES "mapM_/[]"      forall f . mapM_ f [] = return () #-}
{-# RULES "sequence_/++"  forall xs ys . sequence_ (xs ++ ys) = sequence_ xs >> sequence_ ys #-}
{-# RULES "mapM_/++"      forall xs ys f . mapM_ f (xs ++ ys) = mapM_ f xs >> mapM_ f ys #-}

mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f as = go as where
/home/gwern/bin/krasin/nacl-jhc/lib/jhc/Jhc/List.hs
{-# RULES "foldr/nil" forall k z.   foldr k z []  = z  #-}
{-# RULES "foldr/single"  forall k z x . foldr k z [x] = k x z #-}
{-# RULES "foldr/double"  forall k z x y . foldr k z [x,y] = k x (k y z) #-}
{-# RULES "foldr/triple"  forall k z a b c . foldr k z [a,b,c] = k a (k b (k c z)) #-}
{-# RULES "foldr/id"      foldr (:) [] = \x -> x  #-}
{- "foldr/app"    	[1] forall ys. foldr (:) ys = \xs -> xs ++ ys -}

{-# RULES "foldr/build" forall k z (g :: forall b . (a -> b -> b) -> b -> b) . foldr k z (build g) = g k z #-}
{-# RULES "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .  foldr k z (augment g xs) = g k (foldr k z xs) #-}
{-# RULES "foldr/single" forall k z x. foldr k z [x] = k x z #-}
{-# RULES "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
		       (h::forall b. (a->b->b) -> b -> b) .
		       augment g (build h) = build (\c n -> g c (h c n)) #-}
{-# RULES "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .  augment g [] = build g #-}

{-# RULES "foldr/unpackString"  forall k z (addr::Addr__) . foldr k z (unpackString addr) = unpackStringFoldr addr k z  #-}

-- a few pre-fusioned routines

--
{-# RULES "tail/map"      forall f xs . tail (map f xs) = map f (tail xs) #-}
{-# RULES "head/map"      forall f xs . head (map f xs) = f (head xs) #-}
{-# RULES "head/:"        forall x xs . head (x:xs) = x #-}
{-# RULES "tail/:"        forall x xs . tail (x:xs) = xs #-}

{-# RULES "filter/iterate" forall p f x . filter p (iterate f x) = filterIterate p f x  #-}
{-# RULES "map/iterate" forall f g x . map f (iterate g x) = mapIterate f g x  #-}
{-# RULES "map/filter" forall f p xs . map f (filter p xs) = mapFilter f p xs  #-}
{-# RULES "filter/map" forall f p xs . filter p (map f xs) = filterMap p f xs  #-}

-- efficient implementations of prelude routines

--
{-# RULES "any/build"     forall p (g::forall b.(a->b->b)->b->b) .  any p (build g) = g ((||) . p) False #-}

{-# RULES "all/build"     forall p (g::forall b.(a->b->b)->b->b) .  all p (build g) = g ((&&) . p) True #-}

any, all         :: (a -> Bool) -> [a] -> Bool
--
{-# RULES "elem/[]" forall c . elem c [] = False #-}
{-# RULES "elem/[_]" forall c v . elem c [v] = c == v #-}

notElem	_ []	=  True
notElem x (y:ys)
--
{-# RULES "notElem/[]" forall c . notElem c [] = True #-}
{-# RULES "notElem/[_]" forall c v . notElem c [v] = c /= v #-}

infixl 9  !!

--
{-# RULES "head/iterate"  forall f x . head (iterate f x) = x #-}
{-# RULES "head/repeat"   forall x . head (repeat x) = x #-}
{-# RULES "tail/repeat"   forall x . tail (repeat x) = repeat x #-}
{-# RULES "tail/iterate"  forall f x . tail (iterate f x) = iterate f (f x) #-}
{-# RULES "iterate/id" forall . iterate id = repeat #-}

--
{-# RULES "head/build"   forall (g::forall b.(a->b->b)->b->b) . head (build g) = g (\x _ -> x) badHead #-}

{-# RULES "head/augment"   forall xs (g::forall b. (a->b->b) -> b -> b) .  head (augment g xs) = g (\x _ -> x) (head xs) #-}

--repeat x = build (\c _n -> repeatFB c x)
--repeatFB c x = xs where xs = x `c` xs
--
{-# RULES forall xs n (g :: forall b . (a -> b -> b) -> b -> b) . build g !! n  = bangBang g n  #-}

bangBang :: (forall b . (a -> b -> b) -> b -> b) -> Int -> a
g `bangBang` n
/home/gwern/bin/krasin/nacl-jhc/lib/jhc/Prelude/IO.hs
{-# RULES "putStr/++"      forall xs ys . putStr (xs ++ ys) = putStr xs >> putStr ys #-}

putStr     :: String -> IO ()
putStr s   =  mapM_ putChar s
/home/gwern/bin/krasin/nacl-jhc/lib/jhc/Prelude.hs
{-# RULES "sum/Int" forall . sum = sum' :: [Int] -> Int #-}
{-# SPECIALIZE sum' :: [Double] -> Double #-}
{-# RULES "sum/Double" forall . sum = sum' :: [Double] -> Double #-}

-- maximum and minimum return the maximum or minimum value from a list,
-- which must be non-empty, finite, and of an ordered type.
--
{-# RULES "drop/0"        forall . drop 0 = \xs -> xs #-}
{-# RULES "drop/1"        forall x xs . drop 1 (x:xs) = xs #-}
{-# RULES "drop/2"        forall x y xs . drop 2 (x:y:xs) = xs #-}
{-# RULES "drop/3"        forall x y z xs . drop 3 (x:y:z:xs) = xs #-}
{-# RULES "take/0"        forall xs . take 0 xs = [] #-}
{-# RULES "take/1"        forall x xs . take 1 (x:xs) = [x] #-}
{-# RULES "take/2"        forall x y xs . take 2 (x:y:xs) = [x,y] #-}
{-# RULES "take/3"        forall x y z xs . take 3 (x:y:z:xs) = [x,y,z] #-}
{-# RULES "!!/0"          forall x xs . (x:xs) !! 0 = x #-}
{-# RULES "!!/1"          forall x y xs . (x:y:xs) !! 1 = y #-}
{-# RULES "!!/2"          forall x y z xs . (x:y:z:xs) !! 2 = z #-}
{-# RULES "concat/Map"    forall f xs . concat (map f xs) = concatMap f xs #-}
{-# RULES "sequence/map"  forall f xs . sequence (map f xs) = mapM f xs #-}
{-# RULES "sequence_/map" forall f xs . sequence_ (map f xs) = mapM_ f xs #-}
{-# RULES "++/emptyr"     forall xs . xs ++ [] = xs #-}
{-# RULES "++/refix"      forall xs ys zs . (xs ++ ys) ++ zs = xs ++ (ys ++ zs) #-}
--{-# RULES "++/tick4"      forall x y z x' xs ys . (x:y:z:x':xs) ++ ys = x:y:z:x':(xs ++ ys) #-}
--{-# RULES "++/tick2"      forall x y xs ys . (x:y:xs) ++ ys = x:y:(xs ++ ys) #-}
--{-# RULES "++/tick1"      forall x xs ys . (x:xs) ++ ys = x:(xs ++ ys) #-}
{-# RULES "++/tick0"      forall xs . [] ++ xs = xs #-}
{-# RULES "++/tick1"      forall x xs . [x] ++ xs = x:xs #-}
{-# RULES "++/tick2"      forall x y xs . [x,y] ++ xs = x:y:xs #-}
{-# RULES "++/tick3"      forall x y z xs . [x,y,z] ++ xs = x:y:z:xs #-}
{-# RULES "map/map"       forall f g xs . map f (map g xs) = map (\x -> f (g x)) xs #-}
{-# RULES "concatMap/map" forall f g xs . concatMap f (map g xs) = concatMap (\x -> f (g x)) xs #-}
{---# RULES "concat/tick"   forall x xs . concat (x:xs) = x ++ concat xs #-}
{-# RULES "concat/[]"     concat [] = [] #-}
{-# RULES "map/[]"        forall f . map f [] = [] #-}
{-# RULES "concatMap/[]"  forall f . concatMap f [] = [] #-}
{-# RULES "concatMap/++"  forall xs ys f . concatMap f (xs ++ ys) = concatMap f xs ++ concatMap f ys #-}
{-# RULES "map/++"        forall xs ys f . map f (xs ++ ys) = map f xs ++ map f ys #-}

{-# RULES "foldr/map" forall k z f xs . foldr k z (map f xs) = foldr (\x y -> k (f x) y) z xs #-}
{-# RULES "foldr/concatMap" forall k z f xs . foldr k z (concatMap f xs) = foldr (\x y -> foldr k (f x) y) z xs #-}
{-# RULES "foldr/filter" forall k z f xs . foldr k z (filter f xs) = foldr (\x y -> if f x then k x y else y) z xs #-}
{-# RULES "foldr/++" forall k z xs ys . foldr k z (xs ++ ys) = foldr k (foldr k z ys) xs #-}
{-# RULES "foldr/concat" forall k z xs . foldr k z (concat xs) = foldr (\x y -> foldr k y x) z xs #-}
{-# RULES "foldr/repeat" forall k _z x . foldr k _z (repeat x) = let r = k x r in r #-}
-- causes horrible code bloat
-- {-# RULES "foldr/x:xs" forall k z x xs . foldr k z (x:xs) = k x (foldr k z xs) #-}
{-# RULES "foldr/zip" forall k z xs ys . foldr k z (zip xs ys) = let zip' (a:as) (b:bs) = k (a,b) (zip' as bs); zip' _ _ = z in zip' xs ys #-}
-- {-# RULES "foldr/sequence" forall k z xs . foldr k z (sequence xs) = foldr (\x y -> do rx <- x; ry <- y; return (k rx ry)) (return z) xs #-}
-- {-# RULES "foldr/mapM" forall k z f xs . foldr k z (mapM f xs) = foldr (\x y -> do rx <- f x; ry <- y; return (k rx ry)) (return z) xs   #-}
{-# RULES "take/repeat"   forall n x . take n (repeat x) = replicate n x #-}

default(Int,Double)
/home/gwern/bin/Dridus/portaudio/oldsrc/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/tmcdonell/cuda/Foreign/CUDA/Internal/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/tmcdonell/cuda/examples/common/src/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/rduplain/datavault-lite/tools/catalogue/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/bos/bloomfilter/Data/BloomFilter.hs
{-# RULES "Bloom insertB . insertB" forall a b u.
    insertB b (insertB a u) = insertListB [a,b] u
  #-}

{-# RULES "Bloom insertListB . insertB" forall x xs u.
    insertListB xs (insertB x u) = insertListB (x:xs) u
  #-}

{-# RULES "Bloom insertB . insertListB" forall x xs u.
    insertB x (insertListB xs u) = insertListB (x:xs) u
  #-}

{-# RULES "Bloom insertListB . insertListB" forall xs ys u.
    insertListB xs (insertListB ys u) = insertListB (xs++ys) u
  #-}

{-# RULES "Bloom insertListB . emptyB" forall h n xs.
    insertListB xs (emptyB h n) = fromListB h n xs
  #-}

{-# RULES "Bloom insertListB . singletonB" forall h n x xs.
    insertListB xs (singletonB h n x) = fromListB h n (x:xs)
  #-}

--
{-# RULES "Bloom insertListB . fromListB" forall h n xs ys.
    insertListB xs (fromListB h n ys) = fromListB h n (xs ++ ys)
  #-}

/home/gwern/bin/bos/text/Data/Text/Fusion/Common.hs
{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

-- ----------------------------------------------------------------------------
-- * Basic stream functions
/home/gwern/bin/bos/text/Data/Text/Encoding.hs
{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
    forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

-- | Decode a 'ByteString' containing UTF-8 encoded text..
/home/gwern/bin/bos/text/Data/Text/Fusion.hs
{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

-- ----------------------------------------------------------------------------
/home/gwern/bin/bos/text/Data/Text/Lazy/Fusion.hs
{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
    stream (unstream s) = s #-}

-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/simplCore/should_run/simplrun002.hs
{-# RULES "foo" forall v .  fst (sndSnd v) = trace "Yes" (fst v) #-}

main :: IO ()
main = print (fst (sndSnd (True, (False,True))))
/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/simplCore/should_run/SeqRule.hs
{-# RULES 
     "f/seq" forall n e.  seq (f n) e = True
 #-}

/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/simplCore/should_compile/simpl011.hs
{-# RULES "update/ST" update = updateST #-}
updateST:: STHashTable s k v -> k -> v -> ST s Bool
updateST= update'

/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/simplCore/should_compile/rule2.hs
{-# RULES "foo/bar" foo = bar #-}

blip = foo id

/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/simplCore/should_compile/T4398.hs
{-# RULES "suspicious" forall (x :: a) y. f (x :: Ord a => a) y = g x y  #-}

{-# NOINLINE f #-}
f :: a -> a -> Bool
/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/simplCore/should_compile/rule1.hs
{-# RULES 
  "f" forall w. f (\v->w) = w 
 #-}

/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/driver/recomp005/C2.hs
{-# RULES "f/g"  forall x . f (g x) = x #-}
/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/gadt/T3638.hs
{-# RULES "foo"  forall x. foo x = case x of { TInt -> 0 } #-}
/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/typecheck/should_run/tcrun022.hs
{-# RULES 

-- this rule will not fire if the type argument of `T' is constrained to `()'
--
/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/typecheck/should_compile/T3346.hs
{-# RULES "rule1"   forall x. to (from x) = x #-}
{-# RULES "rule2"   forall x. from (to x) = x #-}

foo :: EP a => a -> a
-- This is typed in a way rather similarly to RULE rule1
/home/gwern/bin/thoughtpolice/testsuite/tests/ghc-regress/typecheck/should_compile/T2497.hs
{-# RULES "id" forall (x :: a). id x = x #-}

/home/gwern/bin/altaic/testsuite/tests/ghc-regress/simplCore/should_run/simplrun002.hs
{-# RULES "foo" forall v .  fst (sndSnd v) = trace "Yes" (fst v) #-}

main :: IO ()
main = print (fst (sndSnd (True, (False,True))))
/home/gwern/bin/altaic/testsuite/tests/ghc-regress/simplCore/should_run/SeqRule.hs
{-# RULES 
     "f/seq" forall n e.  seq (f n) e = True
 #-}

/home/gwern/bin/altaic/testsuite/tests/ghc-regress/simplCore/should_compile/simpl011.hs
{-# RULES "update/ST" update = updateST #-}
updateST:: STHashTable s k v -> k -> v -> ST s Bool
updateST= update'

/home/gwern/bin/altaic/testsuite/tests/ghc-regress/simplCore/should_compile/rule2.hs
{-# RULES "foo/bar" foo = bar #-}

blip = foo id

/home/gwern/bin/altaic/testsuite/tests/ghc-regress/simplCore/should_compile/T4398.hs
{-# RULES "suspicious" forall (x :: a) y. f (x :: Ord a => a) y = g x y  #-}

{-# NOINLINE f #-}
f :: a -> a -> Bool
/home/gwern/bin/altaic/testsuite/tests/ghc-regress/simplCore/should_compile/rule1.hs
{-# RULES 
  "f" forall w. f (\v->w) = w 
 #-}

/home/gwern/bin/altaic/testsuite/tests/ghc-regress/driver/recomp005/C2.hs
{-# RULES "f/g"  forall x . f (g x) = x #-}
/home/gwern/bin/altaic/testsuite/tests/ghc-regress/gadt/T3638.hs
{-# RULES "foo"  forall x. foo x = case x of { TInt -> 0 } #-}
/home/gwern/bin/altaic/testsuite/tests/ghc-regress/typecheck/should_run/tcrun022.hs
{-# RULES 

-- this rule will not fire if the type argument of `T' is constrained to `()'
--
/home/gwern/bin/altaic/testsuite/tests/ghc-regress/typecheck/should_compile/T3346.hs
{-# RULES "rule1"   forall x. to (from x) = x #-}
{-# RULES "rule2"   forall x. from (to x) = x #-}

foo :: EP a => a -> a
-- This is typed in a way rather similarly to RULE rule1
/home/gwern/bin/altaic/testsuite/tests/ghc-regress/typecheck/should_compile/T2497.hs
{-# RULES "id" forall (x :: a). id x = x #-}

/home/gwern/bin/copumpkin/natural-gmp/GHC/Natural.hs
{-# RULES "toWord#" forall i. toWord# (T# i) = i #-}
-- Don't inline toWord#, because it can't do much unless
-- it sees a (T# i), and inlining just creates fruitless
-- join points.  But we do need a RULE to get the constants
--
{-# RULES "gcdNatural/Int" forall a b.
            gcdNatural (T# a) (T# b) = T# (gcdWord a b)
  #-}
gcdWord :: Word# -> Word# -> Word#
/home/gwern/bin/yhc/src/interactive/GenUtil.hs
{-# RULES "snub/snub" forall x . snub (snub x) = snub x #-}
{-# RULES "snub/nub" forall x . snub (nub x) = snub x #-}
{-# RULES "nub/snub" forall x . nub (snub x) = snub x #-}
{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}
{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}
{-# RULES "snub/[]" snub [] = [] #-}
{-# RULES "snub/[x]" forall x . snub [x] = [x] #-}

-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
snub :: Ord a => [a] -> [a]
--
{-# RULES "replicateM/0" replicateM 0 = const (return []) #-}
{-# RULES "replicateM_/0" replicateM_ 0 = const (return ()) #-}

{-# INLINE replicateM #-}
{-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-}
/home/gwern/bin/carray/Data/Array/CArray/Base.hs
{-# RULES "cmpCArray/Int" cmpCArray = cmpIntCArray #-}

instance (Ix ix, Eq e, IArray CArray e) => Eq (CArray ix e) where
    (==) = eqCArray
/home/gwern/bin/hsopencl/System/HsOpenCL/Internal/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/pumpkin-uvector/Data/Array/Vector/Prim/BUArr.hs
{-# RULES  -- -} (for font-locking)

"streamBU/unstreamBU" forall s.
  streamBU (unstreamBU s) = s
/home/gwern/bin/text/Data/Text/Fusion/Common.hs
{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

-- ----------------------------------------------------------------------------
-- * Basic stream functions
/home/gwern/bin/text/Data/Text/Fusion.hs
{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

-- ----------------------------------------------------------------------------
/home/gwern/bin/text/Data/Text/Lazy/Fusion.hs
{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
    stream (unstream s) = s #-}

-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/simplCore/should_run/simplrun002.hs
{-# RULES "foo" forall v .  fst (sndSnd v) = trace "Yes" (fst v) #-}

main :: IO ()
main = print (fst (sndSnd (True, (False,True))))
/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/simplCore/should_run/SeqRule.hs
{-# RULES 
     "f/seq" forall n e.  seq (f n) e = True
 #-}

/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/simplCore/should_compile/simpl011.hs
{-# RULES "update/ST" update = updateST #-}
updateST:: STHashTable s k v -> k -> v -> ST s Bool
updateST= update'

/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/simplCore/should_compile/rule2.hs
{-# RULES "foo/bar" foo = bar #-}

blip = foo id

/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/simplCore/should_compile/T4398.hs
{-# RULES "suspicious" forall (x :: a) y. f (x :: Ord a => a) y = g x y  #-}

{-# NOINLINE f #-}
f :: a -> a -> Bool
/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/simplCore/should_compile/rule1.hs
{-# RULES 
  "f" forall w. f (\v->w) = w 
 #-}

/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/driver/recomp005/C2.hs
{-# RULES "f/g"  forall x . f (g x) = x #-}
/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/gadt/T3638.hs
{-# RULES "foo"  forall x. foo x = case x of { TInt -> 0 } #-}
/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/typecheck/should_run/tcrun022.hs
{-# RULES 

-- this rule will not fire if the type argument of `T' is constrained to `()'
--
/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/typecheck/should_compile/T3346.hs
{-# RULES "rule1"   forall x. to (from x) = x #-}
{-# RULES "rule2"   forall x. from (to x) = x #-}

foo :: EP a => a -> a
-- This is typed in a way rather similarly to RULE rule1
/home/gwern/bin/mchakravarty/testsuite/tests/ghc-regress/typecheck/should_compile/T2497.hs
{-# RULES "id" forall (x :: a). id x = x #-}

/home/gwern/bin/parallel/Control/Parallel/Strategies.hs
{-# RULES 
"parList/rwhnf" parList rwhnf = parListWHNF
"parBuffer/rwhnf" forall n . parBuffer n rwhnf = (`using` parBufferWHNF n)
 #-}
/home/gwern/bin/agda/src/full/Agda/Compiler/MAlonzo/Compiler.hs
  , "{-# RULES \"coerce-id\" forall (x :: a) . mazCoerce x = x #-}"
  ]
  where
    parse = HS.parseWithMode
/home/gwern/bin/mak/random-suff/para.hs
{-# RULES "cataTree/anaTree -> hyloTree"
  forall f g s p a. cataTree f g (anaTree s p a) = hyloTree f g s p a
  #-}

/home/gwern/bin/mak/course-haskell/list4/foldBuild/FB.hs
{-# RULES 
"repeat" [~1] forall x. repeat x = build (\c n -> repeatFB c x)
"repeatFB "  [1]  repeatFB (:) = repeatL
  #-}
/home/gwern/bin/c2hs/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/c2hs/_darcs/pristine/C2HS.hs
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}
/home/gwern/bin/tanimoto/iteratee/src/Data/Iteratee/List/IO.hs
{-# RULES "enumHandleSize/String" enumHandleSize = enumHandleSizeString #-}
enumHandleSizeString :: Int -> Handle -> Enumerator String IO a
enumHandleSizeString = enumHandleWithSize (flip (curry peekCAStringLen))
{-# INLINE enumHandleSizeString #-}
/home/gwern/bin/ekmett/kan-extensions/Data/Functor/Yoneda.hs
{-# RULES "lower/lift=id" liftYonedaT . lowerYonedaT = id #-}
{-# RULES "lift/lower=id" lowerYonedaT . liftYonedaT = id #-}

instance Functor (YonedaT f) where
  fmap f m = YonedaT (\k -> runYonedaT m (k . f))
--
-- {-# RULES "max/maxF" max = maxF #-}
{-# INLINE maxF #-}

minF :: (Functor f, Ord (f a)) => YonedaT f a -> YonedaT f a -> YonedaT f a
--
-- {-# RULES "min/minF" min = minF #-}
{-# INLINE minF #-}

maxM :: (Monad m, Ord (m a)) => YonedaT m a -> YonedaT m a -> YonedaT m a
--
-- {-# RULES "max/maxM" max = maxM #-}
{-# INLINE maxM #-}

minM :: (Monad m, Ord (m a)) => YonedaT m a -> YonedaT m a -> YonedaT m a
--
-- {-# RULES "min/minM" min = minM #-}
{-# INLINE minM #-}

instance Alt f => Alt (YonedaT f) where
/home/gwern/bin/ekmett/adjunctions/Data/Functor/Contravariant/Yoneda.hs
-- {-# RULES "max/maxF" max = maxF #-}
{-# INLINE maxF #-}

minF :: (Contravariant f, Ord (f a)) => YonedaT f a -> YonedaT f a -> YonedaT f a
--
-- {-# RULES "min/minF" min = minF #-}
{-# INLINE minF #-}
/home/gwern/bin/squadette/ghc/compiler/simplCore/CSE.lhs
	{-# RULES "foo/no" foo no = id #-}

	bar :: Int -> Int
	bar = foo yes
/home/gwern/bin/squadette/ghc/compiler/simplCore/OccurAnal.lhs
	{-# RULES forall d. $dm Int d  = $s$dm1
		  forall d. $dm Bool d = $s$dm2 #-}

	dInt = MkD .... opInt ...
/home/gwern/bin/squadette/ghc/compiler/simplCore/Simplify.lhs
	{-# RULES forall d. $dm Int d = $s$dm #-}

	dInt = MkD .... opInt ...
	opInt {Arity 1} = $dm dInt
/home/gwern/bin/squadette/ghc/compiler/utils/FastString.lhs
{-# RULES "slit"
    forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
{-# RULES "fslit"
    forall x . fsLit (unpackCString# x) = mkFastString# x #-}
\end{code}
/home/gwern/bin/squadette/ghc/compiler/typecheck/TcHsSyn.lhs
	--   {-# RULES "myrule"  foo C = 1 #-}
	-- 
	-- After type checking the LHS becomes (foo a (C a))
	-- and we do not want to zap the unbound tyvar 'a' to (), because
/home/gwern/bin/squadette/ghc/compiler/typecheck/TcSimplify.lhs
	{-# RULES "foo"  fromIntegral = id :: Int -> Int #-}

In the rule, a=b=Int, and Num Int is a superclass of Integral Int. But
we *dont* want to get
/home/gwern/bin/ghc/libraries/integer-gmp/GHC/Integer.lhs
{-# RULES "toInt#" forall i. toInt# (S# i) = i #-}
-- Don't inline toInt#, because it can't do much unless
-- it sees a (S# i), and inlining just creates fruitless
-- join points.  But we do need a RULE to get the constants
--
{-# RULES "gcdInteger/Int" forall a b.
            gcdInteger (S# a) (S# b) = S# (gcdInt a b)
  #-}
gcdInt :: Int# -> Int# -> Int#
/home/gwern/bin/ghc/libraries/base/GHC/Arr.lhs
{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
\end{code}

/home/gwern/bin/ghc/libraries/base/GHC/Base.lhs
{-# RULES "eqString" (==) = eqString #-}
-- eqString also has a BuiltInRule in PrelRules.lhs:
--      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
\end{code}
/home/gwern/bin/ghc/libraries/base/GHC/Real.lhs
{-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}
instance  (Integral a)  => Fractional (Ratio a)  where
    {-# SPECIALIZE instance Fractional Rational #-}
    (x:%y) / (x':%y')   =  (x*y') % (y*x')
--
{-# RULES "(^)/Rational"    (^) = (^%^) #-}
(^%^)           :: Integral a => Rational -> a -> Rational
(n :% d) ^%^ e
    | e < 0     = error "Negative exponent"
--
{-# RULES "(^^)/Rational"   (^^) = (^^%^^) #-}
(^^%^^)         :: Integral a => Rational -> a -> Rational
(n :% d) ^^%^^ e
    | e > 0     = (n ^ e) :% (d ^ e)
/home/gwern/bin/ghc/compiler/simplCore/CSE.lhs
	{-# RULES "foo/no" foo no = id #-}

	bar :: Int -> Int
	bar = foo yes
/home/gwern/bin/ghc/compiler/simplCore/OccurAnal.lhs
	 {-# RULES "tagZero" [~1] forall xs n.
	     pmap fromBool <blah blah> = tagZero xs #-}     
    So tagZero's RHS mentions pmap, and pmap's RULE mentions tagZero.
    However, tagZero can only be inlined in phase 1 and later, while
--
	{-# RULES "foo" [~1] forall x. foo x = bar x #-}

    Here the RULE makes bar recursive; but it's INLINE pragma remains
    non-recursive. It's tempting to then say that 'bar' should not be
--
	{-# RULES forall d. $dm Int d  = $s$dm1
		  forall d. $dm Bool d = $s$dm2 #-}

	dInt = MkD .... opInt ...
/home/gwern/bin/ghc/compiler/simplCore/Simplify.lhs
	{-# RULES forall d. $dm Int d = $s$dm #-}

	dInt = MkD .... opInt ...
	opInt {Arity 1} = $dm dInt
--
   {-# RULES g (h x) = k x
             f (k x) = x #-}
   ...f (g (h x))...
Then we want to rewrite (g (h x)) to (k x) and only then try f's rules. If
/home/gwern/bin/ghc/compiler/specialise/Rules.lhs
--      {-# RULES "truncate/Double->Int" truncate = double2Int #-}
--      double2Int :: Double -> Int
--   We want the specific RULE to beat the built-in class-op rule
isMoreSpecific (BuiltinRule {}) _                = False
/home/gwern/bin/ghc/compiler/deSugar/Desugar.lhs
  {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}

%************************************************************************
/home/gwern/bin/ghc/compiler/coreSyn/CorePrep.lhs
      {-# RULES g $dBool = g$Bool 
                g $dUnit = g$Unit #-}
      g = ...
      {-# RULES forall x. g$Bool True (Just x) = g$Bool_True_Just x #-}
      g$Bool = ...
      {-# RULES forall x. g$Unit () (Just x) = g$Unit_Unit_Just x #-}
      g$Unit = ...
      g$Bool_True_Just = ...
      g$Unit_Unit_Just = ...
/home/gwern/bin/ghc/compiler/utils/FastString.lhs
{-# RULES "slit"
    forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
{-# RULES "fslit"
    forall x . fsLit (unpackCString# x) = mkFastString# x #-}
\end{code}
/home/gwern/bin/ghc/compiler/typecheck/TcRules.lhs
   {-# RULES "foo/bar" foo = bar #-}