[Git][ghc/ghc][wip/T23578] Native 32-bit Enum Int64/Word64 instances
Jaro Reinders (@Noughtmare)
gitlab at gitlab.haskell.org
Tue Aug 1 09:16:47 UTC 2023
Jaro Reinders pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC
Commits:
5993ec36 by Jaro Reinders at 2023-08-01T11:15:47+02:00
Native 32-bit Enum Int64/Word64 instances
This commits adds more performant Enum Int64 and Enum Word64 instances
for 32-bit platforms, replacing the Integer-based implementation.
These instances are a copy of the Enum Int and Enum Word instances with
minimal changes to manipulate Int64 and Word64 instead.
On i386 this yields a 1.5x performance increase and for the JavaScript
back end it even yields a 5.6x speedup.
Metric Decrease:
T18964
- - - - -
2 changed files:
- libraries/base/GHC/Int.hs
- libraries/base/GHC/Word.hs
Changes:
=====================================
libraries/base/GHC/Int.hs
=====================================
@@ -753,27 +753,153 @@ instance Enum Int64 where
| x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
= I# (int64ToInt# x#)
| otherwise = fromEnumError "Int64" x
-#if WORD_SIZE_IN_BITS < 64
+
-- See Note [Stable Unfolding for list producers] in GHC.Enum
{-# INLINE enumFrom #-}
- enumFrom = integralEnumFrom
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINE enumFromThen #-}
- enumFromThen = integralEnumFromThen
+ enumFrom (I64# x) = eftInt64 x maxInt64#
+ where !(I64# maxInt64#) = maxBound
+ -- Blarg: technically I guess enumFrom isn't strict!
+
-- See Note [Stable Unfolding for list producers] in GHC.Enum
{-# INLINE enumFromTo #-}
- enumFromTo = integralEnumFromTo
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINE enumFromThenTo #-}
- enumFromThenTo = integralEnumFromThenTo
-#else
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINE enumFrom #-}
- enumFrom = boundedEnumFrom
+ enumFromTo (I64# x) (I64# y) = eftInt64 x y
+
-- See Note [Stable Unfolding for list producers] in GHC.Enum
{-# INLINE enumFromThen #-}
- enumFromThen = boundedEnumFromThen
-#endif
+ enumFromThen (I64# x1) (I64# x2) = efdInt64 x1 x2
+
+ -- See Note [Stable Unfolding for list producers] in GHC.Enum
+ {-# INLINE enumFromThenTo #-}
+ enumFromThenTo (I64# x1) (I64# x2) (I64# y) = efdtInt64 x1 x2 y
+
+
+-----------------------------------------------------
+-- eftInt64 and eftInt64FB deal with [a..b], which is the
+-- most common form, so we take a lot of care
+-- In particular, we have rules for deforestation
+
+-- See Note [How the Enum rules work] in GHC.Enum
+{-# RULES
+"eftInt64" [~1] forall x y. eftInt64 x y = build (\ c n -> eftInt64FB c n x y)
+"eftInt64List" [1] eftInt64FB (:) [] = eftInt64
+ #-}
+
+{-# NOINLINE [1] eftInt64 #-}
+eftInt64 :: Int64# -> Int64# -> [Int64]
+-- [x1..x2]
+eftInt64 x0 y | isTrue# (x0 `geInt64#` y) = []
+ | otherwise = go x0
+ where
+ go x = I64# x : if isTrue# (x `eqInt64#` y)
+ then []
+ else go (x `plusInt64#` (intToInt64# 1#))
+
+{-# INLINE [0] eftInt64FB #-} -- See Note [Inline FB functions] in GHC.List
+eftInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> r
+eftInt64FB c n x0 y | isTrue# (x0 `geInt64#` y) = n
+ | otherwise = go x0
+ where
+ go x = I64# x `c` if isTrue# (x `eqInt64#` y)
+ then n
+ else go (x `plusInt64#` (intToInt64# 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
+ -- whatever is bound to "c"
+
+
+-----------------------------------------------------
+-- efdInt64 and efdtInt64 deal with [a,b..] and [a,b..c].
+-- The code is more complicated because of worries about Int64 overflow.
+
+-- See Note [How the Enum rules work] in GHC.Enum
+{-# RULES
+"efdtInt64" [~1] forall x1 x2 y.
+ efdtInt64 x1 x2 y = build (\ c n -> efdtInt64FB c n x1 x2 y)
+"efdtInt64UpList" [1] efdtInt64FB (:) [] = efdtInt64
+ #-}
+
+efdInt64 :: Int64# -> Int64# -> [Int64]
+-- [x1,x2..maxInt64]
+efdInt64 x1 x2
+ | isTrue# (x2 `geInt64#` x1) = case maxBound of I64# y -> efdtInt64Up x1 x2 y
+ | otherwise = case maxBound of I64# y -> efdtInt64Dn x1 x2 y
+
+{-# NOINLINE [1] efdtInt64 #-}
+efdtInt64 :: Int64# -> Int64# -> Int64# -> [Int64]
+-- [x1,x2..y]
+efdtInt64 x1 x2 y
+ | isTrue# (x2 `geInt64#` x1) = efdtInt64Up x1 x2 y
+ | otherwise = efdtInt64Dn x1 x2 y
+
+{-# INLINE [0] efdtInt64FB #-} -- See Note [Inline FB functions] in GHC.List
+efdtInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r
+efdtInt64FB c n x1 x2 y
+ | isTrue# (x2 `geInt64#` x1) = efdtInt64UpFB c n x1 x2 y
+ | otherwise = efdtInt64DnFB c n x1 x2 y
+
+-- Requires x2 >= x1
+efdtInt64Up :: Int64# -> Int64# -> Int64# -> [Int64]
+efdtInt64Up x1 x2 y -- Be careful about overflow!
+ | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then [] else [I64# x1]
+ | otherwise = -- Common case: x1 <= x2 <= y
+ let !delta = x2 `subInt64#` x1 -- >= 0
+ !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable
+
+ -- 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 | isTrue# (x `gtInt64#` y') = [I64# x]
+ | otherwise = I64# x : go_up (x `plusInt64#` delta)
+ in I64# x1 : go_up x2
+
+-- Requires x2 >= x1
+{-# INLINE [0] efdtInt64UpFB #-} -- See Note [Inline FB functions] in GHC.List
+efdtInt64UpFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r
+efdtInt64UpFB c n x1 x2 y -- Be careful about overflow!
+ | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then n else I64# x1 `c` n
+ | otherwise = -- Common case: x1 <= x2 <= y
+ let !delta = x2 `subInt64#` x1 -- >= 0
+ !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable
+
+ -- 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 | isTrue# (x `geInt64#` y') = I64# x `c` n
+ | otherwise = I64# x `c` go_up (x `plusInt64#` delta)
+ in I64# x1 `c` go_up x2
+
+-- Requires x2 <= x1
+efdtInt64Dn :: Int64# -> Int64# -> Int64# -> [Int64]
+efdtInt64Dn x1 x2 y -- Be careful about underflow!
+ | isTrue# (y `geInt64#` x2) = if isTrue# (y `geInt64#` x1) then [] else [I64# x1]
+ | otherwise = -- Common case: x1 >= x2 >= y
+ let !delta = x2 `subInt64#` x1 -- <= 0
+ !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable
+
+ -- 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 | isTrue# (x `ltInt64#` y') = [I64# x]
+ | otherwise = I64# x : go_dn (x `plusInt64#` delta)
+ in I64# x1 : go_dn x2
+
+-- Requires x2 <= x1
+{-# INLINE [0] efdtInt64DnFB #-} -- See Note [Inline FB functions] in GHC.List
+efdtInt64DnFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r
+efdtInt64DnFB c n x1 x2 y -- Be careful about underflow!
+ | isTrue# (y `geInt64#` x2) = if isTrue# (y `geInt64#` x1) then n else I64# x1 `c` n
+ | otherwise = -- Common case: x1 >= x2 >= y
+ let !delta = x2 `subInt64#` x1 -- <= 0
+ !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable
+
+ -- 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 | isTrue# (x `ltInt64#` y') = I64# x `c` n
+ | otherwise = I64# x `c` go_dn (x `plusInt64#` delta)
+ in I64# x1 `c` go_dn x2
+
-- | @since 2.01
instance Integral Int64 where
=====================================
libraries/base/GHC/Word.hs
=====================================
@@ -730,37 +730,155 @@ instance Enum Word64 where
| x <= fromIntegral (maxBound::Int)
= I# (word2Int# (word64ToWord# x#))
| otherwise = fromEnumError "Word64" x
-#if WORD_SIZE_IN_BITS < 64
+
-- See Note [Stable Unfolding for list producers] in GHC.Enum
{-# INLINE enumFrom #-}
- enumFrom = integralEnumFrom
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINE enumFromThen #-}
- enumFromThen = integralEnumFromThen
+ enumFrom (W64# x#) = eftWord64 x# maxWord#
+ where !(W64# maxWord#) = maxBound
+ -- Blarg: technically I guess enumFrom isn't strict!
+
-- See Note [Stable Unfolding for list producers] in GHC.Enum
{-# INLINE enumFromTo #-}
- enumFromTo = integralEnumFromTo
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINE enumFromThenTo #-}
- enumFromThenTo = integralEnumFromThenTo
-#else
- -- use Word's Enum as it has better support for fusion. We can't use
- -- `boundedEnumFrom` and `boundedEnumFromThen` -- which use Int's Enum
- -- instance -- because Word64 isn't compatible with Int/Int64's domain.
- --
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINE enumFrom #-}
- enumFrom x = map fromIntegral (enumFrom (fromIntegral x :: Word))
+ enumFromTo (W64# x) (W64# y) = eftWord64 x y
+
-- See Note [Stable Unfolding for list producers] in GHC.Enum
{-# INLINE enumFromThen #-}
- enumFromThen x y = map fromIntegral (enumFromThen (fromIntegral x :: Word) (fromIntegral y))
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINE enumFromTo #-}
- enumFromTo x y = map fromIntegral (enumFromTo (fromIntegral x :: Word) (fromIntegral y))
+ enumFromThen (W64# x1) (W64# x2) = efdWord64 x1 x2
+
-- See Note [Stable Unfolding for list producers] in GHC.Enum
{-# INLINE enumFromThenTo #-}
- enumFromThenTo x y z = map fromIntegral (enumFromThenTo (fromIntegral x :: Word) (fromIntegral y) (fromIntegral z))
-#endif
+ enumFromThenTo (W64# x1) (W64# x2) (W64# y) = efdtWord64 x1 x2 y
+
+
+-----------------------------------------------------
+-- eftWord64 and eftWord64FB deal with [a..b], which is the
+-- most common form, so we take a lot of care
+-- In particular, we have rules for deforestation
+
+{-# RULES
+"eftWord64" [~1] forall x y. eftWord64 x y = build (\ c n -> eftWord64FB c n x y)
+"eftWord64List" [1] eftWord64FB (:) [] = eftWord64
+ #-}
+
+-- The Enum rules for Word64 work much the same way that they do for Int.
+-- See Note [How the Enum rules work].
+
+{-# NOINLINE [1] eftWord64 #-}
+eftWord64 :: Word64# -> Word64# -> [Word64]
+-- [x1..x2]
+eftWord64 x0 y | isTrue# (x0 `gtWord64#` y) = []
+ | otherwise = go x0
+ where
+ go x = W64# x : if isTrue# (x `eqWord64#` y)
+ then []
+ else go (x `plusWord64#` (wordToWord64# 1##))
+
+{-# INLINE [0] eftWord64FB #-} -- See Note [Inline FB functions] in GHC.List
+eftWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> r
+eftWord64FB c n x0 y | isTrue# (x0 `gtWord64#` y) = n
+ | otherwise = go x0
+ where
+ go x = W64# x `c` if isTrue# (x `eqWord64#` y)
+ then n
+ else go (x `plusWord64#` (wordToWord64# 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
+ -- whatever is bound to "c"
+
+
+-----------------------------------------------------
+-- efdWord64 and efdtWord64 deal with [a,b..] and [a,b..c].
+-- The code is more complicated because of worries about Word64 overflow.
+
+-- See Note [How the Enum rules work]
+{-# RULES
+"efdtWord64" [~1] forall x1 x2 y.
+ efdtWord64 x1 x2 y = build (\ c n -> efdtWord64FB c n x1 x2 y)
+"efdtWord64UpList" [1] efdtWord64FB (:) [] = efdtWord64
+ #-}
+
+efdWord64 :: Word64# -> Word64# -> [Word64]
+-- [x1,x2..maxWord64]
+efdWord64 x1 x2
+ | isTrue# (x2 `geWord64#` x1) = case maxBound of W64# y -> efdtWord64Up x1 x2 y
+ | otherwise = case minBound of W64# y -> efdtWord64Dn x1 x2 y
+
+{-# NOINLINE [1] efdtWord64 #-}
+efdtWord64 :: Word64# -> Word64# -> Word64# -> [Word64]
+-- [x1,x2..y]
+efdtWord64 x1 x2 y
+ | isTrue# (x2 `geWord64#` x1) = efdtWord64Up x1 x2 y
+ | otherwise = efdtWord64Dn x1 x2 y
+
+{-# INLINE [0] efdtWord64FB #-} -- See Note [Inline FB functions] in GHC.List
+efdtWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r
+efdtWord64FB c n x1 x2 y
+ | isTrue# (x2 `geWord64#` x1) = efdtWord64UpFB c n x1 x2 y
+ | otherwise = efdtWord64DnFB c n x1 x2 y
+
+-- Requires x2 >= x1
+efdtWord64Up :: Word64# -> Word64# -> Word64# -> [Word64]
+efdtWord64Up x1 x2 y -- Be careful about overflow!
+ | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then [] else [W64# x1]
+ | otherwise = -- Common case: x1 <= x2 <= y
+ let !delta = x2 `subWord64#` x1 -- >= 0
+ !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable
+
+ -- 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 | isTrue# (x `gtWord64#` y') = [W64# x]
+ | otherwise = W64# x : go_up (x `plusWord64#` delta)
+ in W64# x1 : go_up x2
+
+-- Requires x2 >= x1
+{-# INLINE [0] efdtWord64UpFB #-} -- See Note [Inline FB functions] in GHC.List
+efdtWord64UpFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r
+efdtWord64UpFB c n x1 x2 y -- Be careful about overflow!
+ | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then n else W64# x1 `c` n
+ | otherwise = -- Common case: x1 <= x2 <= y
+ let !delta = x2 `subWord64#` x1 -- >= 0
+ !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable
+
+ -- 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 | isTrue# (x `gtWord64#` y') = W64# x `c` n
+ | otherwise = W64# x `c` go_up (x `plusWord64#` delta)
+ in W64# x1 `c` go_up x2
+
+-- Requires x2 <= x1
+efdtWord64Dn :: Word64# -> Word64# -> Word64# -> [Word64]
+efdtWord64Dn x1 x2 y -- Be careful about underflow!
+ | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then [] else [W64# x1]
+ | otherwise = -- Common case: x1 >= x2 >= y
+ let !delta = x2 `subWord64#` x1 -- <= 0
+ !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable
+
+ -- 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 | isTrue# (x `ltWord64#` y') = [W64# x]
+ | otherwise = W64# x : go_dn (x `plusWord64#` delta)
+ in W64# x1 : go_dn x2
+
+-- Requires x2 <= x1
+{-# INLINE [0] efdtWord64DnFB #-} -- See Note [Inline FB functions] in GHC.List
+efdtWord64DnFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r
+efdtWord64DnFB c n x1 x2 y -- Be careful about underflow!
+ | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then n else W64# x1 `c` n
+ | otherwise = -- Common case: x1 >= x2 >= y
+ let !delta = x2 `subWord64#` x1 -- <= 0
+ !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable
+
+ -- 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 | isTrue# (x `ltWord64#` y') = W64# x `c` n
+ | otherwise = W64# x `c` go_dn (x `plusWord64#` delta)
+ in W64# x1 `c` go_dn x2
+
-- | @since 2.01
instance Integral Word64 where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5993ec36727f3d7efe1dd8b452303708cffeef1d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5993ec36727f3d7efe1dd8b452303708cffeef1d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230801/a2257c5c/attachment-0001.html>
More information about the ghc-commits
mailing list