Skip to content

Simplify rewrite rules for enumFromTo #557

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Shimuuar merged 8 commits into from
Oct 5, 2026
Merged

Simplify rewrite rules for enumFromTo #557

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
536215a
Replace explcit seq with bang patterns for readability
Shimuuar Jan 9, 2026
df28a03
Simplify all unconditional rewrites for enumFromTo
Shimuuar Jan 11, 2026
12f2739
Put enumFromTo rules to one place except one for Int64
Shimuuar Jan 11, 2026
7fbc116
Fix rule for Int64 for 32-bit platforms
Shimuuar Jan 11, 2026
54bb602
Add build on 32-bit platform on CI
Shimuuar Jan 18, 2026
98353a9
Sure enough I broke 32-bit build
Shimuuar Jan 18, 2026
ba76084
Float out step function which is common to all specializations
Shimuuar Jan 24, 2026
0eb3116
Fix i386 on CI
Shimuuar Oct 4, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 20 additions & 0 deletions .github/workflows/ci.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -117,3 +117,23 @@ jobs:
run: |
cabal bench all
working-directory: unpacked/
# Job for checking that vector is buildable and works correctly on 32-bit
# systems. Adapted from os-string's CI setup
i386:
needs: cabal
runs-on: ubuntu-24.04
steps:
- name: Checkout
uses: actions/checkout@v1
- name: Prepare script
run: |
echo > run.sh <<EOF
cabal update
cabal build all --write-ghc-environment-files=always
cabal test all --enable-tests --test-show-details=direct
EOF
# ----------------
- name: Test
uses: docker://hasufell/i386-alpine-haskell:3.12
with:
args: sh run.sh
185 changes: 55 additions & 130 deletions vector/src/Data/Vector/Fusion/Bundle/Monadic.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
-- |
-- Module : Data.Vector.Fusion.Bundle.Monadic
-- Copyright : (c) Roman Leshchinskiy 2008-2010
Expand Down Expand Up @@ -105,16 +106,12 @@ import Prelude
, return, fmap, otherwise, id, const, seq, max, maxBound, fromIntegral, truncate
, (+), (-), (<), (<=), (>), (>=), (==), (/=), (&&), (.), ($), (<$), (/) )

import Data.Int ( Int8, Int16, Int32 )
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word ( Word8, Word16, Word32, Word64 )

#include "vector.h"
#include "MachDeps.h"

#if WORD_SIZE_IN_BITS > 32
import Data.Int ( Int64 )
#endif

data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ())

-- | Monadic streams
Expand Down Expand Up @@ -750,7 +747,7 @@ scanl' f = scanlM' (\a b -> return (f a b))
-- | Haskell-style scan with strict accumulator and a monadic operator
scanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a
{-# INLINE scanlM' #-}
scanlM' f z s = z `seq` (z `cons` postscanlM f z s)
scanlM' f !z s = z `cons` postscanlM f z s

-- | Initial-value free scan over a 'Bundle'
scanl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a
Expand Down Expand Up @@ -797,46 +794,27 @@ enumFromTo x y = fromList [x .. y]
-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for
-- overflow which can't happen here.

stepEnumFromToNum
:: (Monad m, Ord a, Num a)
=> a -> Maybe a -> m (Step (Maybe a) a)
{-# INLINE_INNER stepEnumFromToNum #-}
stepEnumFromToNum y = \st -> case st of
Nothing -> return $ Done
Just z
| z == y -> return $ Yield z Nothing
| z < y -> return $ Yield z (Just (z+1))
| otherwise -> return $ Done


-- FIXME: add "too large" test for Int
enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a
{-# INLINE_FUSED enumFromTo_small #-}
enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact n)
enumFromTo_small !x !y
= fromStream (Stream (stepEnumFromToNum y) (Just x)) (Exact n)
where
n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0

{-# INLINE_INNER step #-}
step Nothing = return $ Done
step (Just z) | z == y = return $ Yield z Nothing
| z < y = return $ Yield z (Just (z+1))
| otherwise = return $ Done

{-# RULES

"enumFromTo<Int8> [Bundle]"
enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8

"enumFromTo<Int16> [Bundle]"
enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16

"enumFromTo<Word8> [Bundle]"
enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8

"enumFromTo<Word16> [Bundle]"
enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16 #-}



#if WORD_SIZE_IN_BITS > 32

{-# RULES

"enumFromTo<Int32> [Bundle]"
enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32

"enumFromTo<Word32> [Bundle]"
enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Bundle m v Word32 #-}

#endif

-- NOTE: We could implement a generic "too large" test:
--
Expand All @@ -852,7 +830,8 @@ enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact

enumFromTo_int :: forall m v. (HasCallStack, Monad m) => Int -> Int -> Bundle m v Int
{-# INLINE_FUSED enumFromTo_int #-}
enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y))
enumFromTo_int !x !y
= fromStream (Stream (stepEnumFromToNum y) (Just x)) (Exact (len x y))
where
{-# INLINE [0] len #-}
len :: HasCallStack => Int -> Int -> Int
Expand All @@ -861,15 +840,10 @@ enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (l
where
n = v-u+1

{-# INLINE_INNER step #-}
step Nothing = return $ Done
step (Just z) | z == y = return $ Yield z Nothing
| z < y = return $ Yield z (Just (z+1))
| otherwise = return $ Done

enumFromTo_intlike :: forall m v a. (HasCallStack, Integral a, Monad m) => a -> a -> Bundle m v a
{-# INLINE_FUSED enumFromTo_intlike #-}
enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y))
enumFromTo_intlike !x !y
= fromStream (Stream (stepEnumFromToNum y) (Just x)) (Exact (len x y))
where
{-# INLINE [0] len #-}
len :: HasCallStack => a -> a -> Int
Expand All @@ -880,34 +854,10 @@ enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exac
where
n = v-u+1

{-# INLINE_INNER step #-}
step Nothing = return $ Done
step (Just z) | z == y = return $ Yield z Nothing
| z < y = return $ Yield z (Just (z+1))
| otherwise = return $ Done

{-# RULES

"enumFromTo<Int> [Bundle]"
enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int

#if WORD_SIZE_IN_BITS > 32

"enumFromTo<Int64> [Bundle]"
enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-}

#else

"enumFromTo<Int32> [Bundle]"
enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Bundle m v Int32 #-}

#endif



enumFromTo_big_word :: forall m v a. (HasCallStack, Integral a, Monad m) => a -> a -> Bundle m v a
{-# INLINE_FUSED enumFromTo_big_word #-}
enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y))
enumFromTo_big_word !x !y
= fromStream (Stream (stepEnumFromToNum y) (Just x)) (Exact (len x y))
where
{-# INLINE [0] len #-}
len :: HasCallStack => a -> a -> Int
Expand All @@ -918,40 +868,13 @@ enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exa
where
n = v-u

{-# INLINE_INNER step #-}
step Nothing = return $ Done
step (Just z) | z == y = return $ Yield z Nothing
| z < y = return $ Yield z (Just (z+1))
| otherwise = return $ Done

{-# RULES

"enumFromTo<Word> [Bundle]"
enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word

"enumFromTo<Word64> [Bundle]"
enumFromTo = enumFromTo_big_word
:: Monad m => Word64 -> Word64 -> Bundle m v Word64

#if WORD_SIZE_IN_BITS == 32

"enumFromTo<Word32> [Bundle]"
enumFromTo = enumFromTo_big_word
:: Monad m => Word32 -> Word32 -> Bundle m v Word32

#endif

"enumFromTo<Integer> [Bundle]"
enumFromTo = enumFromTo_big_word
:: Monad m => Integer -> Integer -> Bundle m v Integer #-}


#if WORD_SIZE_IN_BITS > 32

-- FIXME: the "too large" test is totally wrong
enumFromTo_big_int :: forall m v a. (HasCallStack, Integral a, Monad m) => a -> a -> Bundle m v a
{-# INLINE_FUSED enumFromTo_big_int #-}
enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y))
enumFromTo_big_int !x !y
= fromStream (Stream (stepEnumFromToNum y) (Just x)) (Exact (len x y))
where
{-# INLINE [0] len #-}
len :: HasCallStack => a -> a -> Int
Expand All @@ -961,26 +884,11 @@ enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exac
$ fromIntegral n
where
n = v-u+1

{-# INLINE_INNER step #-}
step Nothing = return $ Done
step (Just z) | z == y = return $ Yield z Nothing
| z < y = return $ Yield z (Just (z+1))
| otherwise = return $ Done


{-# RULES

"enumFromTo<Int64> [Bundle]"
enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-}



#endif

enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char
{-# INLINE_FUSED enumFromTo_char #-}
enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n)
enumFromTo_char !x !y = fromStream (Stream step xn) (Exact n)
where
xn = ord x
yn = ord y
Expand All @@ -991,11 +899,6 @@ enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n)
step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1)
| otherwise = return $ Done

{-# RULES

"enumFromTo<Char> [Bundle]"
enumFromTo = enumFromTo_char #-}



------------------------------------------------------------------------
Expand All @@ -1005,7 +908,7 @@ enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n)

enumFromTo_double :: forall m v a. (HasCallStack, Monad m, Ord a, RealFrac a) => a -> a -> Bundle m v a
{-# INLINE_FUSED enumFromTo_double #-}
enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step ini) (Max (len n lim))
enumFromTo_double !n !m = fromStream (Stream step ini) (Max (len n lim))
where
lim = m + 1/2 -- important to float out

Expand All @@ -1025,14 +928,36 @@ enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step ini) (Max (len n
x' = x + n

{-# RULES
"enumFromTo<Int8> [Bundle]" enumFromTo @Int8 = enumFromTo_small
"enumFromTo<Int16> [Bundle]" enumFromTo @Int16 = enumFromTo_small
"enumFromTo<Word8> [Bundle]" enumFromTo @Word8 = enumFromTo_small
"enumFromTo<Word16> [Bundle]" enumFromTo @Word16 = enumFromTo_small

"enumFromTo<Double> [Bundle]"
enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double

"enumFromTo<Float> [Bundle]"
enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Bundle m v Float #-}
"enumFromTo<Int> [Bundle]" enumFromTo @Int = enumFromTo_int
"enumFromTo<Word> [Bundle]" enumFromTo @Word = enumFromTo_big_word
"enumFromTo<Word64> [Bundle]" enumFromTo @Word64 = enumFromTo_big_word
"enumFromTo<Integer> [Bundle]" enumFromTo @Integer = enumFromTo_big_word

"enumFromTo<Char> [Bundle]" enumFromTo @Char = enumFromTo_char
"enumFromTo<Double> [Bundle]" enumFromTo @Double = enumFromTo_double
"enumFromTo<Float> [Bundle]" enumFromTo @Float = enumFromTo_double
#-}

#if WORD_SIZE_IN_BITS > 32
-- 64bit systems
{-# RULES
"enumFromTo<Int32> [Bundle]" enumFromTo @Int32 = enumFromTo_small
"enumFromTo<Int64> [Bundle]" enumFromTo @Int64 = enumFromTo_intlike
"enumFromTo<Word32> [Bundle]" enumFromTo @Word32 = enumFromTo_small
#-}
#else
-- 32bit systems
{-# RULES
"enumFromTo<Int32> [Bundle]" enumFromTo @Int32 = enumFromTo_intlike
"enumFromTo<Word32> [Bundle]" enumFromTo @Word32 = enumFromTo_big_word
"enumFromTo<Int64> [Bundle]" enumFromTo @Int64 = enumFromTo_big_int
#-}
#endif

------------------------------------------------------------------------

Expand Down Expand Up @@ -1071,7 +996,7 @@ unsafeFromList sz xs = fromStream (S.fromList xs) sz

fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a
{-# INLINE_FUSED fromVector #-}
fromVector v = v `seq` n `seq` Bundle (Stream step 0)
fromVector !v = n `seq` Bundle (Stream step 0)
(Stream vstep True)
(Just v)
(Exact n)
Expand Down
Loading