/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@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@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@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@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 = 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 #-} He wanted the rule to typecheck. /home/gwern/bin/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/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/gitpan/Language-Haskell/hugs98-Nov2003/fptools/libraries/base/GHC/Arr.lhs {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} /home/gwern/bin/gitpan/Language-Haskell/hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs {-# RULES "truncate/Float->Int" truncate = float2Int #-} instance RealFrac Float where {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-} -- {-# RULES "truncate/Double->Int" truncate = double2Int #-} instance RealFrac Double where {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-} /home/gwern/bin/gitpan/Language-Haskell/hugs98-Nov2003/fptools/libraries/base/GHC/Base.lhs {-# RULES "eqString" (==) = eqString #-} \end{code} /home/gwern/bin/cse-ghc-plugin/CSE/Pass.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/scpmw/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/scpmw/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/scpmw/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/scpmw/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/scpmw/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/scpmw/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/scpmw/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/scpmw/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/scpmw/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/scpmw/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/dysinger/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/dysinger/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/dysinger/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/dysinger/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/dysinger/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/dysinger/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/dysinger/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/dysinger/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/dysinger/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/dysinger/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/axman6/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/axman6/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/axman6/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/axman6/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/axman6/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/axman6/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/axman6/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/axman6/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/axman6/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/axman6/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/lhc/lib/base/src/GHC/Arr.lhs {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} /home/gwern/bin/lhc/lib/base/src/GHC/Float.lhs {-# RULES "truncate/Float->Int" truncate = float2Int #-} instance RealFrac Float where {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-} -- {-# RULES "truncate/Double->Int" truncate = double2Int #-} instance RealFrac Double where {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-} /home/gwern/bin/lhc/lib/base/src/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/eamsden/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/eamsden/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/eamsden/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/eamsden/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/eamsden/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/eamsden/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/eamsden/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/eamsden/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/eamsden/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/eamsden/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/dmpots/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/dmpots/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/dmpots/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/dmpots/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/dmpots/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/dmpots/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/dmpots/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/dmpots/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/dmpots/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/dmpots/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/dmpots/lhc/lib/base/src/GHC/Arr.lhs {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} /home/gwern/bin/dmpots/lhc/lib/base/src/GHC/Float.lhs {-# RULES "truncate/Float->Int" truncate = float2Int #-} instance RealFrac Float where {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-} -- {-# RULES "truncate/Double->Int" truncate = double2Int #-} instance RealFrac Double where {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-} /home/gwern/bin/dmpots/lhc/lib/base/src/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/chrisdone/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/chrisdone/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/chrisdone/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/chrisdone/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/chrisdone/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/chrisdone/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/chrisdone/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/chrisdone/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/chrisdone/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/chrisdone/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/yyuki/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/yyuki/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/yyuki/ghc/compiler/simplCore/Simplify.lhs {-# RULES forall d. $dm Int d = $s$dm #-} dInt = MkD .... opInt ... opInt {Arity 1} = $dm dInt /home/gwern/bin/yyuki/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/yyuki/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/yyuki/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/mtnviewmark/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/mtnviewmark/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/mtnviewmark/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/mtnviewmark/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/mtnviewmark/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/mtnviewmark/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/mtnviewmark/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/mtnviewmark/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/mtnviewmark/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/mtnviewmark/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/nominolo/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/nominolo/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/nominolo/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/nominolo/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/nominolo/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/nominolo/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/nominolo/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/nominolo/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/nominolo/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/nominolo/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/nominolo/packages-base/GHC/Arr.lhs {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} /home/gwern/bin/nominolo/packages-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/nominolo/packages-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/tibbe/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/tibbe/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/tibbe/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/tibbe/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/tibbe/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/tibbe/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/tibbe/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/tibbe/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/tibbe/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/tibbe/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/dagit/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/dagit/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/dagit/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/dagit/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/dagit/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/dagit/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/dagit/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/dagit/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/dagit/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/dagit/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/ezyang/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/ezyang/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/ezyang/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/ezyang/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/ezyang/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/ezyang/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/ezyang/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/ezyang/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/ezyang/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/ezyang/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/thoughtpolice/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/thoughtpolice/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/thoughtpolice/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/thoughtpolice/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/thoughtpolice/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/thoughtpolice/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/thoughtpolice/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/thoughtpolice/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/thoughtpolice/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/thoughtpolice/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/thoughtpolice/cse-ghc-plugin/CSE/Pass.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/altaic/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/altaic/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/altaic/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/altaic/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/altaic/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/altaic/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/altaic/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/altaic/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/altaic/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/altaic/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/altaic/packages-base/GHC/Arr.lhs {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} /home/gwern/bin/altaic/packages-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/altaic/packages-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/michalt/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/michalt/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/michalt/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/michalt/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/michalt/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/michalt/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/michalt/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/michalt/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/michalt/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/michalt/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/the-real-blackh/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/the-real-blackh/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/the-real-blackh/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/the-real-blackh/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/the-real-blackh/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/the-real-blackh/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/the-real-blackh/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/the-real-blackh/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/the-real-blackh/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/the-real-blackh/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/mchakravarty/ghc/compiler/simplCore/CSE.lhs {-# RULES "foo/no" foo no = id #-} bar :: Int -> Int bar = foo yes /home/gwern/bin/mchakravarty/ghc/compiler/simplCore/OccurAnal.lhs {-# RULES "tagZero" [~1] forall xs n. pmap fromBool = 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/mchakravarty/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/mchakravarty/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/mchakravarty/ghc/compiler/deSugar/Desugar.lhs {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} %************************************************************************ /home/gwern/bin/mchakravarty/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/mchakravarty/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/mchakravarty/ghc/compiler/typecheck/TcRules.lhs {-# RULES "foo/bar" foo = bar #-} He wanted the rule to typecheck. /home/gwern/bin/mchakravarty/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/mchakravarty/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 forall dIntegralInt. -- {-# RULES "foo" forall (v::forall b. Eq b => b->b). f b True = ... #=} Here we *must* solve the wanted (Eq a) from the given (Eq a) /home/gwern/bin/mchakravarty/packages-base/GHC/Arr.lhs {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} /home/gwern/bin/mchakravarty/packages-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/mchakravarty/packages-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)