Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6fae60c48d13b4c3d8cbb3bf317b1af95d162924 >--------------------------------------------------------------- commit 6fae60c48d13b4c3d8cbb3bf317b1af95d162924 Author: Ian Lynagh <[email protected]> Date: Thu Oct 25 17:13:36 2012 +0100 Make sure testBit and bit get inlined; fixes #7292 >--------------------------------------------------------------- Data/Bits.hs | 8 ++++++-- 1 files changed, 6 insertions(+), 2 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index 5b1e1d4..abbadbd 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -252,18 +252,22 @@ class Eq a => Bits a where class Bits b => FiniteBits b where finiteBitSize :: b -> Int +-- The defaults below are written with lambdas so that e.g. +-- bit = bitDefault +-- is fully applied, so inlining will happen + -- | Default implementation for 'bit'. -- -- Note that: @bitDefault i = 1 `shiftL` i@ bitDefault :: (Bits a, Num a) => Int -> a -bitDefault i = 1 `shiftL` i +bitDefault = \i -> 1 `shiftL` i {-# INLINE bitDefault #-} -- | Default implementation for 'testBit'. -- -- Note that: @testBitDefault x i = (x .&. bit i) /= 0@ testBitDefault :: (Bits a, Num a) => a -> Int -> Bool -testBitDefault x i = (x .&. bit i) /= 0 +testBitDefault = \x i -> (x .&. bit i) /= 0 {-# INLINE testBitDefault #-} -- | Default implementation for 'popCount'. _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
