Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2927f027aea6cb81beec2e1524432956fc5c1d33 >--------------------------------------------------------------- commit 2927f027aea6cb81beec2e1524432956fc5c1d33 Author: Roman Leshchinskiy <[email protected]> Date: Thu Dec 29 15:54:09 2011 +0000 Improve unfoldings >--------------------------------------------------------------- Data/Vector/Internal/Check.hs | 24 +++++++++++++++++++++++- 1 files changed, 23 insertions(+), 1 deletions(-) diff --git a/Data/Vector/Internal/Check.hs b/Data/Vector/Internal/Check.hs index 47e5819..253b9a3 100644 --- a/Data/Vector/Internal/Check.hs +++ b/Data/Vector/Internal/Check.hs @@ -21,9 +21,31 @@ module Data.Vector.Internal.Check ( import GHC.Base( Int(..) ) import GHC.Prim( Int# ) -import Prelude hiding( error ) +import Prelude hiding( error, (&&), (||), not ) import qualified Prelude as P +-- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline +-- these functions into unfoldings which makes the intermediate code size +-- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539. +infixr 2 || +infixr 3 && + +not :: Bool -> Bool +{-# INLINE not #-} +not True = False +not False = True + +(&&) :: Bool -> Bool -> Bool +{-# INLINE (&&) #-} +False && x = False +True && x = x + +(||) :: Bool -> Bool -> Bool +{-# INLINE (||) #-} +True || x = True +False || x = x + + data Checks = Bounds | Unsafe | Internal deriving( Eq ) doBoundsChecks :: Bool _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
