[Git][ghc/ghc][wip/T23578] Native 32-bit Enum Int64/Word64 instances

Jaro Reinders (@Noughtmare) gitlab at gitlab.haskell.org
Fri Jul 28 12:39:02 UTC 2023



Jaro Reinders pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC


Commits:
95ddecef by Jaro Reinders at 2023-07-28T14:32:38+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.

- - - - -


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/95ddecef92de3d7390ec4ab9d706cc75083831e1

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95ddecef92de3d7390ec4ab9d706cc75083831e1
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/20230728/c98e6bc9/attachment-0001.html>


More information about the ghc-commits mailing list