[Git][ghc/ghc][wip/int64-everywhere] Copy enumFrom* implementations from Int/Word for Int64/Word64
John Ericson
gitlab at gitlab.haskell.org
Sat Aug 29 21:29:53 UTC 2020
John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC
Commits:
523014ef by John Ericson at 2020-08-29T17:22:19-04:00
Copy enumFrom* implementations from Int/Word for Int64/Word64
Without this, we don't get proper list fusion.
I think this sort of copying is OK for now, but we absolutely need
something better if we are going to make `IntN` use `IntN#` for all `N`.
The degree to which proper metaprogramming has been punted upon by
factoring everything through the native-sized types is disconcerting.
- - - - -
2 changed files:
- libraries/base/GHC/Int.hs
- libraries/base/GHC/Word.hs
Changes:
=====================================
libraries/base/GHC/Int.hs
=====================================
@@ -753,14 +753,147 @@ instance Enum Int64 where
| x /= minBound = x - 1
| otherwise = predError "Int64"
toEnum (I# i#) = I64# (intToInt64# i#)
+#if WORD_SIZE_IN_BITS >= 64
+ fromEnum (I64# x#) = I# (int64ToInt# x#)
+#else
fromEnum x@(I64# x#)
| x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
= I# (int64ToInt# x#)
| otherwise = fromEnumError "Int64" x
- enumFrom = integralEnumFrom
- enumFromThen = integralEnumFromThen
- enumFromTo = integralEnumFromTo
- enumFromThenTo = integralEnumFromThenTo
+#endif
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINE enumFrom #-}
+ 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]
+ {-# INLINE enumFromTo #-}
+ enumFromTo (I64# x) (I64# y) = eftInt64 x y
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINE enumFromThen #-}
+ enumFromThen (I64# x1) (I64# x2) = efdInt64 x1 x2
+
+ -- See Note [Stable Unfolding for list producers]
+ {-# INLINE enumFromThenTo #-}
+ enumFromThenTo (I64# x1) (I64# x2) (I64# y) = efdtInt64 x1 x2 y
+
+-- Modeled after fusion helpers in GHC.Enum for Int
+-- See Note [How the Enum rules work]
+
+{-# 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 `gtInt64#` y) = []
+ | otherwise = go x0
+ where
+ !one = intToInt64# 1#
+ go x = I64# x : if isTrue# (x `eqInt64#` y)
+ then []
+ else go (x `plusInt64#` one)
+
+{-# NOINLINE [0] eftInt64FB #-}
+eftInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> r
+eftInt64FB c n x0 y | isTrue# (x0 `gtInt64#` y) = n
+ | otherwise = go x0
+ where
+ !one = intToInt64# 1#
+ go x = I64# x `c` if isTrue# (x `eqInt64#` y)
+ then n
+ else go (x `plusInt64#` one)
+
+{-# 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 minBound 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 `gtInt64#` 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 `gtInt64#` x2) = if isTrue# (y `gtInt64#` 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 `gtInt64#` x2) = if isTrue# (y `gtInt64#` 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
=====================================
@@ -739,10 +739,20 @@ instance Enum Word64 where
| x <= fromIntegral (maxBound::Int)
= I# (word2Int# (word64ToWord# x#))
| otherwise = fromEnumError "Word64" x
- enumFrom = integralEnumFrom
- enumFromThen = integralEnumFromThen
- enumFromTo = integralEnumFromTo
- enumFromThenTo = integralEnumFromThenTo
+
+ {-# INLINE enumFrom #-}
+ enumFrom (W64# x#) = eftWord64 x# maxWord64#
+ where !(W64# maxWord64#) = maxBound
+ -- Blarg: technically I guess enumFrom isn't strict!
+
+ {-# INLINE enumFromTo #-}
+ enumFromTo (W64# x) (W64# y) = eftWord64 x y
+
+ {-# INLINE enumFromThen #-}
+ enumFromThen (W64# x1) (W64# x2) = efdWord64 x1 x2
+
+ {-# INLINE enumFromThenTo #-}
+ enumFromThenTo (W64# x1) (W64# x2) (W64# y) = efdtWord64 x1 x2 y
-- | @since 2.01
instance Integral Word64 where
@@ -766,6 +776,122 @@ instance Integral Word64 where
| otherwise = divZeroError
toInteger (W64# x#) = integerFromWord64# x#
+-- Modeled after fusion helpers in GHC.Enum for Word
+-- See Note [How the Enum rules work]
+--
+{-# RULES
+"eftWord64" [~1] forall x y. eftWord64 x y = build (\ c n -> eftWord64FB c n x y)
+"eftWord64List" [1] eftWord64FB (:) [] = eftWord64
+ #-}
+
+{-# NOINLINE [1] eftWord64 #-}
+eftWord64 :: Word64# -> Word64# -> [Word64]
+-- [x1..x2]
+eftWord64 x0 y | isTrue# (x0 `gtWord64#` y) = []
+ | otherwise = go x0
+ where
+ !one = wordToWord64# 1##
+ go x = W64# x : if isTrue# (x `eqWord64#` y)
+ then []
+ else go (x `plusWord64#` one)
+
+{-# 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
+ !one = wordToWord64# 1##
+ go x = W64# x `c` if isTrue# (x `eqWord64#` y)
+ then n
+ else go (x `plusWord64#` one)
+
+{-# 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 Bits Word64 where
{-# INLINE shift #-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/523014efd4ca02f4410e847fb01b72bcb766f3b8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/523014efd4ca02f4410e847fb01b72bcb766f3b8
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/20200829/e8628ac3/attachment-0001.html>
More information about the ghc-commits
mailing list