Commit ad896994 authored by Jan Stolarek's avatar Jan Stolarek
Browse files

Follow changes in comparison primops (see #6135)

parent acb313ad
......@@ -326,7 +326,7 @@ forkOS action0
isCurrentThreadBound :: IO Bool
isCurrentThreadBound = IO $ \ s# ->
case isCurrentThreadBound# s# of
(# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
(# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)
{- |
......
......@@ -294,11 +294,11 @@ instance Bits Int where
complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I# x#) `shift` (I# i#)
| i# >=# 0# = I# (x# `iShiftL#` i#)
| otherwise = I# (x# `iShiftRA#` negateInt# i#)
(I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
| isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#)
| otherwise = I# (x# `iShiftRA#` negateInt# i#)
(I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
(I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
(I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
(I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
(I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
{-# INLINE rotate #-} -- See Note [Constant folding for rotate]
......@@ -330,14 +330,14 @@ instance Bits Word where
complement (W# x#) = W# (x# `xor#` mb#)
where !(W# mb#) = maxBound
(W# x#) `shift` (I# i#)
| i# >=# 0# = W# (x# `shiftL#` i#)
| otherwise = W# (x# `shiftRL#` negateInt# i#)
(W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#)
| isTrue# (i# >=# 0#) = W# (x# `shiftL#` i#)
| otherwise = W# (x# `shiftRL#` negateInt# i#)
(W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#)
(W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
(W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#)
(W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#)
(W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
(W# x#) `rotate` (I# i#)
| i'# ==# 0# = W# x#
| isTrue# (i'# ==# 0#) = W# x#
| otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
where
!i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
......
......@@ -227,7 +227,7 @@ instance Ix Int where
| otherwise = indexError b i "Int"
{-# INLINE inRange #-}
inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
inRange (I# m,I# n) (I# i) = isTrue# (m <=# i) && isTrue# (i <=# n)
instance Ix Word where
range (m,n) = [m..n]
......@@ -411,7 +411,7 @@ data STArray s i e
-- Just pointer equality on mutable arrays:
instance Eq (STArray s i e) where
STArray _ _ _ arr1# == STArray _ _ _ arr2# =
sameMutableArray arr1# arr2#
isTrue# (sameMutableArray# arr1# arr2#)
\end{code}
......@@ -509,7 +509,7 @@ listArray :: Ix i => (i,i) -> [e] -> Array i e
listArray (l,u) es = runST (ST $ \s1# ->
case safeRangeSize (l,u) of { n@(I# n#) ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
let fillFromList i# xs s3# | i# ==# n# = s3#
let fillFromList i# xs s3# | isTrue# (i# ==# n#) = s3#
| otherwise = case xs of
[] -> s3#
y:ys -> case writeArray# marr# i# y s3# of { s4# ->
......@@ -816,7 +816,7 @@ unsafeWriteSTArray (STArray _ _ _ marr#) (I# i#) e = ST $ \s1# ->
freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
freezeSTArray (STArray l u n@(I# n#) marr#) = ST $ \s1# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) ->
let copy i# s3# | i# ==# n# = s3#
let copy i# s3# | isTrue# (i# ==# n#) = s3#
| otherwise =
case readArray# marr# i# s3# of { (# s4#, e #) ->
case writeArray# marr'# i# e s4# of { s5# ->
......@@ -834,7 +834,7 @@ unsafeFreezeSTArray (STArray l u n marr#) = ST $ \s1# ->
thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
thawSTArray (Array l u n@(I# n#) arr#) = ST $ \s1# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
let copy i# s3# | i# ==# n# = s3#
let copy i# s3# | isTrue# (i# ==# n#) = s3#
| otherwise =
case indexArray# arr# i# of { (# e #) ->
case writeArray# marr# i# e s3# of { s4# ->
......
......@@ -16,10 +16,6 @@ GHC.Prim Has no implementation. It defines built-in things, and
The source file is GHC.Prim.hi-boot, which is just
copied to make GHC.Prim.hi
GHC.PrimWrappers
Provides wrappers for built-in comparison operators.
These wrappers take unboxed operands and return a Bool.
GHC.Base Classes: Eq, Ord, Functor, Monad
Types: list, (), Int, Bool, Ordering, Char, String
......@@ -105,8 +101,8 @@ module GHC.Base
module GHC.CString,
module GHC.Magic,
module GHC.Types,
module GHC.Prim, -- Re-export GHC.Prim, GHC.PrimWrappers and
module GHC.PrimWrappers,-- [boot] GHC.Err, to avoid lots of people having to
module GHC.Prim, -- Re-export GHC.Prim and [boot] GHC.Err,
-- to avoid lots of people having to
module GHC.Err -- import it explicitly
)
where
......@@ -117,7 +113,6 @@ import GHC.CString
import GHC.Magic
import GHC.Prim
import GHC.Err
import GHC.PrimWrappers
import {-# SOURCE #-} GHC.IO (failIO)
-- This is not strictly speaking required by this module, but is an
......@@ -675,11 +670,14 @@ divModInt :: Int -> Int -> (Int, Int)
divModInt# :: Int# -> Int# -> (# Int#, Int# #)
x# `divModInt#` y#
| (x# ># 0#) && (y# <# 0#) = case (x# -# 1#) `quotRemInt#` y# of
(# q, r #) -> (# q -# 1#, r +# y# +# 1# #)
| (x# <# 0#) && (y# ># 0#) = case (x# +# 1#) `quotRemInt#` y# of
(# q, r #) -> (# q -# 1#, r +# y# -# 1# #)
| otherwise = x# `quotRemInt#` y#
| isTrue# (x# ># 0#) && isTrue# (y# <# 0#) =
case (x# -# 1#) `quotRemInt#` y# of
(# q, r #) -> (# q -# 1#, r +# y# +# 1# #)
| isTrue# (x# <# 0#) && isTrue# (y# ># 0#) =
case (x# +# 1#) `quotRemInt#` y# of
(# q, r #) -> (# q -# 1#, r +# y# -# 1# #)
| otherwise =
x# `quotRemInt#` y#
-- Wrappers for the shift operations. The uncheckedShift# family are
-- undefined when the amount being shifted by is greater than the size
......@@ -692,32 +690,34 @@ x# `divModInt#` y#
-- | Shift the argument left by the specified number of bits
-- (which must be non-negative).
shiftL# :: Word# -> Int# -> Word#
a `shiftL#` b | b >=# WORD_SIZE_IN_BITS# = 0##
| otherwise = a `uncheckedShiftL#` b
a `shiftL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##
| otherwise = a `uncheckedShiftL#` b
-- | Shift the argument right by the specified number of bits
-- (which must be non-negative).
shiftRL# :: Word# -> Int# -> Word#
a `shiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0##
| otherwise = a `uncheckedShiftRL#` b
a `shiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##
| otherwise = a `uncheckedShiftRL#` b
-- | Shift the argument left by the specified number of bits
-- (which must be non-negative).
iShiftL# :: Int# -> Int# -> Int#
a `iShiftL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
| otherwise = a `uncheckedIShiftL#` b
a `iShiftL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#
| otherwise = a `uncheckedIShiftL#` b
-- | Shift the argument right (signed) by the specified number of bits
-- (which must be non-negative).
iShiftRA# :: Int# -> Int# -> Int#
a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
| otherwise = a `uncheckedIShiftRA#` b
a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = if isTrue# (a <# 0#)
then (-1#)
else 0#
| otherwise = a `uncheckedIShiftRA#` b
-- | Shift the argument right (unsigned) by the specified number of bits
-- (which must be non-negative).
iShiftRL# :: Int# -> Int# -> Int#
a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
| otherwise = a `uncheckedIShiftRL#` b
a `iShiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#
| otherwise = a `uncheckedIShiftRL#` b
-- Rules for C strings (the functions themselves are now in GHC.CString)
{-# RULES
......
......@@ -9,7 +9,7 @@ import GHC.Show
-- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'.
chr :: Int -> Char
chr i@(I# i#)
| int2Word# i# `leWord#` 0x10FFFF## = C# (chr# i#)
| isTrue# (int2Word# i# `leWord#` 0x10FFFF##) = C# (chr# i#)
| otherwise
= error ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "")
......@@ -431,8 +431,9 @@ runSparks :: IO ()
runSparks = IO loop
where loop s = case getSpark# s of
(# s', n, p #) ->
if n ==# 0# then (# s', () #)
else p `seq` loop s'
if isTrue# (n ==# 0#)
then (# s', () #)
else p `seq` loop s'
data BlockReason
= BlockedOnMVar
......@@ -489,7 +490,7 @@ threadStatus (ThreadId t) = IO $ \s ->
threadCapability :: ThreadId -> IO (Int, Bool)
threadCapability (ThreadId t) = IO $ \s ->
case threadStatus# t s of
(# s', _, cap#, locked# #) -> (# s', (I# cap#, locked# /=# 0#) #)
(# s', _, cap#, locked# #) -> (# s', (I# cap#, isTrue# (locked# /=# 0#)) #)
-- | make a weak pointer to a 'ThreadId'. It can be important to do
-- this if you want to hold a reference to a 'ThreadId' while still
......@@ -670,7 +671,7 @@ data TVar a = TVar (TVar# RealWorld a)
deriving Typeable
instance Eq (TVar a) where
(TVar tvar1#) == (TVar tvar2#) = sameTVar tvar1# tvar2#
(TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#)
-- |Create a new TVar holding a value supplied
newTVar :: a -> STM (TVar a)
......
......@@ -355,11 +355,11 @@ instance Bounded Char where
instance Enum Char where
succ (C# c#)
| not (ord# c# ==# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
| otherwise = error ("Prelude.Enum.Char.succ: bad argument")
| isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
| otherwise = error ("Prelude.Enum.Char.succ: bad argument")
pred (C# c#)
| not (ord# c# ==# 0#) = C# (chr# (ord# c# -# 1#))
| otherwise = error ("Prelude.Enum.Char.pred: bad argument")
| isTrue# (ord# c# /=# 0#) = C# (chr# (ord# c# -# 1#))
| otherwise = error ("Prelude.Enum.Char.pred: bad argument")
toEnum = chr
fromEnum = ord
......@@ -393,45 +393,45 @@ instance Enum Char where
eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
eftCharFB c n x0 y = go x0
where
go x | x ># y = n
| otherwise = C# (chr# x) `c` go (x +# 1#)
go x | isTrue# (x ># y) = n
| otherwise = C# (chr# x) `c` go (x +# 1#)
{-# NOINLINE [1] eftChar #-}
eftChar :: Int# -> Int# -> String
eftChar x y | x ># y = []
| otherwise = C# (chr# x) : eftChar (x +# 1#) y
eftChar x y | isTrue# (x ># y ) = []
| otherwise = C# (chr# x) : eftChar (x +# 1#) y
-- For enumFromThenTo we give up on inlining
{-# NOINLINE [0] efdCharFB #-}
efdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
efdCharFB c n x1 x2
| delta >=# 0# = go_up_char_fb c n x1 delta 0x10FFFF#
| otherwise = go_dn_char_fb c n x1 delta 0#
| isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta 0x10FFFF#
| otherwise = go_dn_char_fb c n x1 delta 0#
where
!delta = x2 -# x1
{-# NOINLINE [1] efdChar #-}
efdChar :: Int# -> Int# -> String
efdChar x1 x2
| delta >=# 0# = go_up_char_list x1 delta 0x10FFFF#
| otherwise = go_dn_char_list x1 delta 0#
| isTrue# (delta >=# 0#) = go_up_char_list x1 delta 0x10FFFF#
| otherwise = go_dn_char_list x1 delta 0#
where
!delta = x2 -# x1
{-# NOINLINE [0] efdtCharFB #-}
efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
efdtCharFB c n x1 x2 lim
| delta >=# 0# = go_up_char_fb c n x1 delta lim
| otherwise = go_dn_char_fb c n x1 delta lim
| isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta lim
| otherwise = go_dn_char_fb c n x1 delta lim
where
!delta = x2 -# x1
{-# NOINLINE [1] efdtChar #-}
efdtChar :: Int# -> Int# -> Int# -> String
efdtChar x1 x2 lim
| delta >=# 0# = go_up_char_list x1 delta lim
| otherwise = go_dn_char_list x1 delta lim
| isTrue# (delta >=# 0#) = go_up_char_list x1 delta lim
| otherwise = go_dn_char_list x1 delta lim
where
!delta = x2 -# x1
......@@ -439,29 +439,29 @@ go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_up_char_fb c n x0 delta lim
= go_up x0
where
go_up x | x ># lim = n
| otherwise = C# (chr# x) `c` go_up (x +# delta)
go_up x | isTrue# (x ># lim) = n
| otherwise = C# (chr# x) `c` go_up (x +# delta)
go_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_dn_char_fb c n x0 delta lim
= go_dn x0
where
go_dn x | x <# lim = n
| otherwise = C# (chr# x) `c` go_dn (x +# delta)
go_dn x | isTrue# (x <# lim) = n
| otherwise = C# (chr# x) `c` go_dn (x +# delta)
go_up_char_list :: Int# -> Int# -> Int# -> String
go_up_char_list x0 delta lim
= go_up x0
where
go_up x | x ># lim = []
| otherwise = C# (chr# x) : go_up (x +# delta)
go_up x | isTrue# (x ># lim) = []
| otherwise = C# (chr# x) : go_up (x +# delta)
go_dn_char_list :: Int# -> Int# -> Int# -> String
go_dn_char_list x0 delta lim
= go_dn x0
where
go_dn x | x <# lim = []
| otherwise = C# (chr# x) : go_dn (x +# delta)
go_dn x | isTrue# (x <# lim) = []
| otherwise = C# (chr# x) : go_dn (x +# delta)
\end{code}
......@@ -520,17 +520,21 @@ instance Enum Int where
{-# NOINLINE [1] eftInt #-}
eftInt :: Int# -> Int# -> [Int]
-- [x1..x2]
eftInt x0 y | x0 ># y = []
| otherwise = go x0
eftInt x0 y | isTrue# (x0 ># y) = []
| otherwise = go x0
where
go x = I# x : if x ==# y then [] else go (x +# 1#)
go x = I# x : if isTrue# (x ==# y)
then []
else go (x +# 1#)
{-# INLINE [0] eftIntFB #-}
eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
eftIntFB c n x0 y | x0 ># y = n
| otherwise = go x0
eftIntFB c n x0 y | isTrue# (x0 ># y) = n
| otherwise = go x0
where
go x = I# x `c` if x ==# y then n else go (x +# 1#)
go x = I# x `c` if isTrue# (x ==# y)
then n
else go (x +# 1#)
-- Watch out for y=maxBound; hence ==, not >
-- Be very careful not to have more than one "c"
-- so that when eftInfFB is inlined we can inline
......@@ -549,27 +553,27 @@ eftIntFB c n x0 y | x0 ># y = n
efdInt :: Int# -> Int# -> [Int]
-- [x1,x2..maxInt]
efdInt x1 x2
| x2 >=# x1 = case maxInt of I# y -> efdtIntUp x1 x2 y
| otherwise = case minInt of I# y -> efdtIntDn x1 x2 y
efdInt x1 x2
| isTrue# (x2 >=# x1) = case maxInt of I# y -> efdtIntUp x1 x2 y
| otherwise = case minInt of I# y -> efdtIntDn x1 x2 y
{-# NOINLINE [1] efdtInt #-}
efdtInt :: Int# -> Int# -> Int# -> [Int]
-- [x1,x2..y]
efdtInt x1 x2 y
| x2 >=# x1 = efdtIntUp x1 x2 y
| otherwise = efdtIntDn x1 x2 y
| isTrue# (x2 >=# x1) = efdtIntUp x1 x2 y
| otherwise = efdtIntDn x1 x2 y
{-# INLINE [0] efdtIntFB #-}
efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntFB c n x1 x2 y
| x2 >=# x1 = efdtIntUpFB c n x1 x2 y
| otherwise = efdtIntDnFB c n x1 x2 y
| isTrue# (x2 >=# x1) = efdtIntUpFB c n x1 x2 y
| otherwise = efdtIntDnFB c n x1 x2 y
-- Requires x2 >= x1
efdtIntUp :: Int# -> Int# -> Int# -> [Int]
efdtIntUp x1 x2 y -- Be careful about overflow!
| y <# x2 = if y <# x1 then [] else [I# x1]
| isTrue# (y <# x2) = if isTrue# (y <# x1) then [] else [I# x1]
| otherwise = -- Common case: x1 <= x2 <= y
let !delta = x2 -# x1 -- >= 0
!y' = y -# delta -- x1 <= y' <= y; hence y' is representable
......@@ -577,14 +581,14 @@ efdtIntUp x1 x2 y -- Be careful about overflow!
-- Invariant: x <= y
-- Note that: z <= y' => z + delta won't overflow
-- so we are guaranteed not to overflow if/when we recurse
go_up x | x ># y' = [I# x]
| otherwise = I# x : go_up (x +# delta)
go_up x | isTrue# (x ># y') = [I# x]
| otherwise = I# x : go_up (x +# delta)
in I# x1 : go_up x2
-- Requires x2 >= x1
efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntUpFB c n x1 x2 y -- Be careful about overflow!
| y <# x2 = if y <# x1 then n else I# x1 `c` n
| isTrue# (y <# x2) = if isTrue# (y <# x1) then n else I# x1 `c` n
| otherwise = -- Common case: x1 <= x2 <= y
let !delta = x2 -# x1 -- >= 0
!y' = y -# delta -- x1 <= y' <= y; hence y' is representable
......@@ -592,14 +596,14 @@ efdtIntUpFB c n x1 x2 y -- Be careful about overflow!
-- Invariant: x <= y
-- Note that: z <= y' => z + delta won't overflow
-- so we are guaranteed not to overflow if/when we recurse
go_up x | x ># y' = I# x `c` n
| otherwise = I# x `c` go_up (x +# delta)
go_up x | isTrue# (x ># y') = I# x `c` n
| otherwise = I# x `c` go_up (x +# delta)
in I# x1 `c` go_up x2
-- Requires x2 <= x1
efdtIntDn :: Int# -> Int# -> Int# -> [Int]
efdtIntDn x1 x2 y -- Be careful about underflow!
| y ># x2 = if y ># x1 then [] else [I# x1]
| isTrue# (y ># x2) = if isTrue# (y ># x1) then [] else [I# x1]
| otherwise = -- Common case: x1 >= x2 >= y
let !delta = x2 -# x1 -- <= 0
!y' = y -# delta -- y <= y' <= x1; hence y' is representable
......@@ -607,14 +611,14 @@ efdtIntDn x1 x2 y -- Be careful about underflow!
-- Invariant: x >= y
-- Note that: z >= y' => z + delta won't underflow
-- so we are guaranteed not to underflow if/when we recurse
go_dn x | x <# y' = [I# x]
| otherwise = I# x : go_dn (x +# delta)
go_dn x | isTrue# (x <# y') = [I# x]
| otherwise = I# x : go_dn (x +# delta)
in I# x1 : go_dn x2
-- Requires x2 <= x1
efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntDnFB c n x1 x2 y -- Be careful about underflow!
| y ># x2 = if y ># x1 then n else I# x1 `c` n
| isTrue# (y ># x2) = if isTrue# (y ># x1) then n else I# x1 `c` n
| otherwise = -- Common case: x1 >= x2 >= y
let !delta = x2 -# x1 -- <= 0
!y' = y -# delta -- y <= y' <= x1; hence y' is representable
......@@ -622,8 +626,8 @@ efdtIntDnFB c n x1 x2 y -- Be careful about underflow!
-- Invariant: x >= y
-- Note that: z >= y' => z + delta won't underflow
-- so we are guaranteed not to underflow if/when we recurse
go_dn x | x <# y' = I# x `c` n
| otherwise = I# x `c` go_dn (x +# delta)
go_dn x | isTrue# (x <# y') = I# x `c` n
| otherwise = I# x `c` go_dn (x +# delta)
in I# x1 `c` go_dn x2
\end{code}
......@@ -667,8 +671,8 @@ instance Enum Integer where
{-# INLINE enumFromThen #-}
{-# INLINE enumFromTo #-}
{-# INLINE enumFromThenTo #-}
enumFrom x = enumDeltaInteger x 1
enumFromThen x y = enumDeltaInteger x (y-x)
enumFrom x = enumDeltaInteger x 1
enumFromThen x y = enumDeltaInteger x (y-x)
enumFromTo x lim = enumDeltaToInteger x 1 lim
enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
......
......@@ -28,10 +28,10 @@ module GHC.Exts
-- * Primitive operations
module GHC.Prim,
module GHC.PrimWrappers,
shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
uncheckedShiftL64#, uncheckedShiftRL64#,
uncheckedIShiftL64#, uncheckedIShiftRA64#,
isTrue#,
-- * Fusion
build, augment,
......@@ -67,7 +67,6 @@ module GHC.Exts
import Prelude
import GHC.Prim
import GHC.PrimWrappers
import GHC.Base
import GHC.Word
import GHC.Int
......
......@@ -220,12 +220,12 @@ instance Real Float where
toRational (F# x#) =
case decodeFloat_Int# x# of
(# m#, e# #)
| e# >=# 0# ->
| isTrue# (e# >=# 0#) ->
(smallInteger m# `shiftLInteger` e#) :% 1
| (int2Word# m# `and#` 1##) `eqWord#` 0## ->
| isTrue# ((int2Word# m# `and#` 1##) `eqWord#` 0##) ->
case elimZerosInt# m# (negateInt# e#) of
(# n, d# #) -> n :% shiftLInteger 1 d#
| otherwise ->
| otherwise ->
smallInteger m# :% shiftLInteger 1 (negateInt# e#)
instance Fractional Float where
......@@ -386,12 +386,12 @@ instance Real Double where
toRational (D# x#) =
case decodeDoubleInteger x# of
(# m, e# #)
| e# >=# 0# ->
| isTrue# (e# >=# 0#) ->
shiftLInteger m e# :% 1
| (integerToWord m `and#` 1##) `eqWord#` 0## ->
| isTrue# ((integerToWord m `and#` 1##) `eqWord#` 0##) ->
case elimZerosInteger m (negateInt# e#) of
(# n, d# #) -> n :% shiftLInteger 1 d#
| otherwise ->
| otherwise ->
m :% shiftLInteger 1 (negateInt# e#)
instance Fractional Double where
......@@ -939,12 +939,12 @@ fromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a
fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
case integerLog2IsPowerOf2# d of
(# ld#, pw# #)
| pw# ==# 0# ->
| isTrue# (pw# ==# 0#) ->
case integerLog2# n of
ln# | ln# >=# (ld# +# me# -# 1#) ->
ln# | isTrue# (ln# >=# (ld# +# me# -# 1#)) ->
-- this means n/d >= 2^(minEx-1), i.e. we are guaranteed to get
-- a normalised number, round to mantDigs bits
if ln# <# md#
if isTrue# (ln# <# md#)
then encodeFloat n (I# (negateInt# ld#))
else let n' = n `shiftR` (I# (ln# +# 1# -# md#))
n'' = case roundingMode# n (ln# -# md#) of
......@@ -959,9 +959,9 @@ fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
-- the exponent for encoding is always minEx-mantDigs
-- so we must shift right by (minEx-mantDigs) - (-ld)
case ld# +# (me# -# md#) of
ld'# | ld'# <=# 0# -> -- we would shift left, so we don't shift
ld'# | isTrue# (ld'# <=# 0#) -> -- we would shift left, so we don't shift
encodeFloat n (I# ((me# -# md#) -# ld'#))
| ld'# <=# ln# ->
| isTrue# (ld'# <=# ln#) ->
let n' = n `shiftR` (I# ld'#)
in case roundingMode# n (ld'# -# 1#) of
0# -> encodeFloat n' (minEx - mantDigs)
......@@ -969,7 +969,7 @@ fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
then encodeFloat n' (minEx-mantDigs)
else encodeFloat (n' + 1) (minEx-mantDigs)
_ -> encodeFloat (n' + 1) (minEx-mantDigs)
| ld'# ># (ln# +# 1#) -> encodeFloat 0 0 -- result of shift < 0.5
| isTrue# (ld'# ># (ln# +# 1#)) -> encodeFloat 0 0 -- result of shift < 0.5
| otherwise -> -- first bit of n shifted to 0.5 place
case integerLog2IsPowerOf2# n of
(# _, 0# #) -> encodeFloat 0 0 -- round to even
......@@ -1021,12 +1021,12 @@ negateFloat :: Float -> Float
negateFloat (F# x) = F# (negateFloat# x)
gtFloat, geFloat, eqFloat, neFloat, ltFloat, leFloat :: Float -> Float -> Bool
gtFloat (F# x) (F# y) = gtFloat# x y
geFloat (F# x) (F# y) = geFloat# x y
eqFloat (F# x) (F# y) = eqFloat# x y
neFloat (F# x) (F# y) = neFloat# x y
ltFloat (F# x) (F# y) = ltFloat# x y
leFloat (F# x) (F# y) = leFloat# x y
gtFloat (F# x) (F# y) = isTrue# (gtFloat# x y)
geFloat (F# x) (F# y) = isTrue# (geFloat# x y)
eqFloat (F# x) (F# y) = isTrue# (eqFloat# x y)
neFloat (F# x) (F# y) = isTrue# (neFloat# x y)
ltFloat (F# x) (F# y) = isTrue# (ltFloat# x y)
leFloat (F# x) (F# y) = isTrue# (leFloat# x y)
expFloat, logFloat, sqrtFloat :: Float -> Float
sinFloat, cosFloat, tanFloat :: Float -> Float
......@@ -1061,12 +1061,12 @@ negateDouble :: Double -> Double
negateDouble (D# x) = D# (negateDouble# x)
gtDouble, geDouble, eqDouble, neDouble, leDouble, ltDouble :: Double -> Double -> Bool
gtDouble (D# x) (D# y) = x >## y
geDouble (D# x) (D# y) = x >=## y
eqDouble (D# x) (D# y) = x ==## y
neDouble (D# x) (D# y) = x /=## y
ltDouble (D# x) (D# y) = x <## y
leDouble (D# x) (D# y) = x <=## y
gtDouble (D# x) (D# y) = isTrue# (x >## y)
geDouble (D# x) (D# y) = isTrue# (x >=## y)
eqDouble (D# x) (D# y) = isTrue# (x ==## y)
neDouble (D# x) (D# y) = isTrue# (x /=## y)
ltDouble (D# x) (D# y) = isTrue# (x <## y)
leDouble (D# x) (D# y) = isTrue# (x <=## y)
double2Float :: Double -> Float
double2Float (D# x) = F# (double2Float# x)
......
......@@ -41,9 +41,9 @@ toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))
elim64# :: Int64# -> Int# -> (# Integer, Int# #)
elim64# n e =
case zeroCount (toByte64# n) of
t | e <=# t -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)
| t <# 8# -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)
| otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)
t | isTrue# (e <=# t) -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)
| isTrue# (t <# 8#) -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)
| otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)
#else
......@@ -62,9 +62,9 @@ elimZerosInteger m e = elim64# (TO64 m) e
elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)
elimZerosInt# n e =
case zeroCount (toByte# n) of
t | e <=# t -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)
| t <# 8# -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)
| otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)
t | isTrue# (e <=# t) -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)
| isTrue# (t <# 8#) -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)
| otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)
{-# INLINE zeroCount #-}
zeroCount :: Int# -> Int#
......@@ -87,9 +87,11 @@ zeroCountArr =