From 6de9e9c37b6d266d522942b6624f0722b0283c2a Mon Sep 17 00:00:00 2001 From: konsumlamm Date: Wed, 29 Jan 2025 17:03:41 +0100 Subject: [PATCH 1/2] Fix/improve `Enum` instances --- lib/Data/Enum.hs | 90 ++++++++++++++++++++------- lib/Data/Fixed.hs | 9 +-- lib/Data/Int/Instances.hs | 59 ++++++++++-------- lib/Data/Word.hs | 125 +++++++++++++++++++++++++------------- lib/Numeric/Natural.hs | 9 +++ 5 files changed, 200 insertions(+), 92 deletions(-) diff --git a/lib/Data/Enum.hs b/lib/Data/Enum.hs index 2fc56489..51ab53c5 100644 --- a/lib/Data/Enum.hs +++ b/lib/Data/Enum.hs @@ -1,4 +1,12 @@ -module Data.Enum(module Data.Enum) where +module Data.Enum ( + Enum(..), + boundedEnumFrom, + boundedEnumFromThen, + numericEnumFrom, + numericEnumFromThen, + numericEnumFromTo, + numericEnumFromThenTo, +) where import Prelude() -- do not import Prelude import Primitives import Control.Error @@ -54,41 +62,79 @@ numericEnumFromTo l h = takeWhile (<= h) (numericEnumFrom l) numericEnumFromThenTo :: (Num a, Ord a) => a -> a -> a -> [a] numericEnumFromThenTo l m h = - if m > l then - takeWhile (<= h) (numericEnumFromThen l m) - else - takeWhile (>= h) (numericEnumFromThen l m) + if m > l then + takeWhile (<= h) (numericEnumFromThen l m) + else + takeWhile (>= h) (numericEnumFromThen l m) + +eftInt :: Int -> Int -> [Int] +eftInt x y = if x `primIntGT` y then [] else go x + where + go n = n : if n `primIntEQ` y then [] else go (n `primIntAdd` 1) + +efttIntUp :: Int -> Int -> Int -> [Int] +-- x2 >= x1 +efttIntUp x1 x2 y + | y `primIntLT` x2 = if y `primIntLT` x1 then [] else [x1] + | otherwise = + let + delta = x2 `primIntSub` x1 + y' = y `primIntSub` delta + go x = if x `primIntGT` y' then [x] else x : go (x `primIntAdd` delta) + in x1 : go x2 + +efttIntDown :: Int -> Int -> Int -> [Int] +-- x2 <= x1 +efttIntDown x1 x2 y + | y `primIntGT` x2 = if y `primIntGT` x1 then [] else [x1] + | otherwise = + let + delta = x2 `primIntSub` x1 + y' = y `primIntSub` delta + go x = if x `primIntLT` y' then [x] else x : go (x `primIntAdd` delta) + in x1 : go x2 -- This instance is difficult to put in Data.Int, -- so it gets to live here. instance Enum Int where - succ x = x + 1 - pred x = x - 1 + succ x = if x `primIntEQ` maxBound then error "Int.succ: overflow" else x + 1 + pred x = if x `primIntEQ` minBound then error "Int.pred: underflow" else x - 1 toEnum x = x fromEnum x = x - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = eftInt n maxBound + enumFromThen x1 x2 + | x2 `primIntGE` x1 = efttIntUp x1 x2 maxBound + | otherwise = efttIntDown x1 x2 minBound + enumFromTo = eftInt + enumFromThenTo x1 x2 y + | x2 `primIntGE` x1 = efttIntUp x1 x2 y + | otherwise = efttIntDown x1 x2 y -- Likewise for Bool instance Enum Bool where fromEnum False = 0 fromEnum True = 1 - toEnum i = if primIntEQ i (0::Int) then False else - if primIntEQ i (1::Int) then True else - error "Enum.Bool.toEnum: bad arg" + toEnum i + | i `primIntEQ` 0 = False + | i `primIntEQ` 1 = True + | otherwise = error "Enum.Bool.toEnum: bad arg" + enumFrom = boundedEnumFrom + enumFromThen = boundedEnumFromThen instance Enum Char where fromEnum = primOrd toEnum = primChr - + enumFrom = boundedEnumFrom + enumFromThen = boundedEnumFromThen instance Enum Ordering where - fromEnum LT = (0::Int) - fromEnum EQ = (1::Int) - fromEnum GT = (2::Int) - toEnum i = if i `primIntEQ` 0 then LT - else if i `primIntEQ` 1 then EQ - else if i `primIntEQ` 2 then GT - else error "Ord.toEnum: out of range" + fromEnum LT = 0 + fromEnum EQ = 1 + fromEnum GT = 2 + toEnum i + | i `primIntEQ` 0 = LT + | i `primIntEQ` 1 = EQ + | i `primIntEQ` 2 = GT + | otherwise = error "Ord.toEnum: out of range" + enumFrom = boundedEnumFrom + enumFromThen = boundedEnumFromThen diff --git a/lib/Data/Fixed.hs b/lib/Data/Fixed.hs index 6bc92edd..96008efd 100644 --- a/lib/Data/Fixed.hs +++ b/lib/Data/Fixed.hs @@ -38,6 +38,7 @@ import Data.TypeLits (KnownNat, natVal) import Text.Read.Internal import Text.ParserCombinators.ReadPrec import Text.Read.Lex +import Data.Coerce import Data.Double import Data.Floating import Data.Fractional @@ -98,10 +99,10 @@ instance Enum (Fixed a) where pred (MkFixed a) = MkFixed (pred a) toEnum = MkFixed . toEnum fromEnum (MkFixed a) = fromEnum a - enumFrom (MkFixed a) = fmap MkFixed (enumFrom a) - enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b) - enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b) - enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) + enumFrom (MkFixed a) = coerce (enumFrom a) + enumFromThen (MkFixed a) (MkFixed b) = coerce (enumFromThen a b) + enumFromTo (MkFixed a) (MkFixed b) = coerce (enumFromTo a b) + enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = coerce (enumFromThenTo a b c) instance (HasResolution a) => Num (Fixed a) where (MkFixed a) + (MkFixed b) = MkFixed (a + b) diff --git a/lib/Data/Int/Instances.hs b/lib/Data/Int/Instances.hs index 30fb7961..0568890b 100644 --- a/lib/Data/Int/Instances.hs +++ b/lib/Data/Int/Instances.hs @@ -3,8 +3,9 @@ import Prelude() import Primitives import Control.Error import Data.Bits -import Data.Bool_Type +import Data.Bool import Data.Bounded +import Data.Coerce import Data.Enum import Data.Eq import Data.Function @@ -69,14 +70,16 @@ instance Read Int8 where -} instance Enum Int8 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Int8.succ: overflow" else x + 1 + pred x = if x == minBound then error "Int8.pred: underflow" else x - 1 toEnum = i8 fromEnum = unI8 - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Int) + enumFromThenTo = coerce (enumFromThenTo @Int) instance Eq Int8 where (==) = cmp8 primIntEQ @@ -165,14 +168,16 @@ instance Read Int16 where -} instance Enum Int16 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Int16.succ: overflow" else x + 1 + pred x = if x == minBound then error "Int16.pred: underflow" else x - 1 toEnum = i16 fromEnum = unI16 - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Int) + enumFromThenTo = coerce (enumFromThenTo @Int) instance Eq Int16 where (==) = cmp16 primIntEQ @@ -261,14 +266,16 @@ instance Read Int32 where -} instance Enum Int32 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Int32.succ: overflow" else x + 1 + pred x = if x == minBound then error "Int32.pred: underflow" else x - 1 toEnum = i32 fromEnum = unI32 - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Int) + enumFromThenTo = coerce (enumFromThenTo @Int) instance Eq Int32 where (==) = cmp32 primIntEQ @@ -356,14 +363,16 @@ instance Read Int64 where -} instance Enum Int64 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Int64.succ: overflow" else x + 1 + pred x = if x == minBound then error "Int64.pred: underflow" else x - 1 toEnum = i64 fromEnum = unI64 - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Int) + enumFromThenTo = coerce (enumFromThenTo @Int) instance Eq Int64 where (==) = cmp64 primIntEQ diff --git a/lib/Data/Word.hs b/lib/Data/Word.hs index a67e70d6..5a56ac8c 100644 --- a/lib/Data/Word.hs +++ b/lib/Data/Word.hs @@ -5,9 +5,10 @@ import Prelude() -- do not import Prelude import Primitives import Control.Error import Data.Bits -import Data.Bool_Type +import Data.Bool import Data.Bounded import Data.Char +import Data.Coerce import Data.Enum import Data.Eq import Data.Function @@ -53,15 +54,48 @@ instance Read Word where -------------------------------- +eftWord :: Word -> Word -> [Word] +eftWord x y + | x `primWordGT` y = [] + | otherwise = go x + where + go n = n : if n `primWordEQ` y then [] else go (n `primWordAdd` 1) + +efttWordUp :: Word -> Word -> Word -> [Word] +-- x2 >= x1 +efttWordUp x1 x2 y + | y `primWordLT` x2 = if y `primWordLT` x1 then [] else [x1] + | otherwise = + let + delta = x2 `primWordSub` x1 + y' = y `primWordSub` delta + go x = if x `primWordGT` y' then [x] else x : go (x `primWordAdd` delta) + in x1 : go x2 + +efttWordDown :: Word -> Word -> Word -> [Word] +-- x2 <= x1 +efttWordDown x1 x2 y + | y `primWordGT` x2 = if y `primWordGT` x1 then [] else [x1] + | otherwise = + let + delta = x2 `primWordSub` x1 + y' = y `primWordSub` delta + go x = if x `primWordLT` y' then [x] else x : go (x `primWordAdd` delta) + in x1 : go x2 + instance Enum Word where - succ x = x + 1 - pred x = x - 1 + succ x = if x `primWordEQ` maxBound then error "Word.succ: overflow" else x + 1 + pred x = if x `primWordEQ` minBound then error "Word.pred: underflow" else x - 1 toEnum = primIntToWord fromEnum = primWordToInt - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = eftWord n maxBound + enumFromThen x1 x2 + | x2 `primWordGE` x1 = efttWordUp x1 x2 maxBound + | otherwise = efttWordDown x1 x2 minBound + enumFromTo = eftWord + enumFromThenTo x1 x2 y + | x2 `primWordGE` x1 = efttWordUp x1 x2 y + | otherwise = efttWordDown x1 x2 y -------------------------------- @@ -86,12 +120,12 @@ instance Bits Word where x `shiftL` i | i < 0 = _overflowError | i >= _wordSize = 0 - | True = x `primWordShl` i + | otherwise = x `primWordShl` i unsafeShiftL = primWordShl x `shiftR` i | i < 0 = _overflowError | i >= _wordSize = 0 - | True = x `primWordShr` i + | otherwise = x `primWordShr` i unsafeShiftR = primWordShr bitSizeMaybe _ = Just _wordSize bitSize _ = _wordSize @@ -156,14 +190,16 @@ instance Read Word8 where -} instance Enum Word8 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Word8.succ: overflow" else x + 1 + pred x = if x == minBound then error "Word8.pred: underflow" else x - 1 toEnum = w8 . primIntToWord fromEnum = primWordToInt . unW8 - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Word) + enumFromThenTo = coerce (enumFromThenTo @Word) instance Eq Word8 where (==) = cmp8 primWordEQ @@ -184,12 +220,12 @@ instance Bits Word8 where x `shiftL` i | i < 0 = _overflowError | i >= 8 = 0 - | True = x `unsafeShiftL` i + | otherwise = x `unsafeShiftL` i unsafeShiftL = bini8 primWordShl x `shiftR` i | i < 0 = _overflowError | i >= 8 = 0 - | True = x `unsafeShiftR` i + | otherwise = x `unsafeShiftR` i unsafeShiftR = bini8 primWordShr bitSizeMaybe _ = Just 8 bitSize _ = 8 @@ -254,13 +290,16 @@ instance Read Word16 where -} instance Enum Word16 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Word16.succ: overflow" else x + 1 + pred x = if x == minBound then error "Word16.pred: underflow" else x - 1 toEnum = w16 . primIntToWord - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + fromEnum = primWordToInt . unW16 + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Word) + enumFromThenTo = coerce (enumFromThenTo @Word) instance Eq Word16 where (==) = cmp16 primWordEQ @@ -281,12 +320,12 @@ instance Bits Word16 where x `shiftL` i | i < 0 = _overflowError | i >= 16 = 0 - | True = x `unsafeShiftL` i + | otherwise = x `unsafeShiftL` i unsafeShiftL = bini16 primWordShl x `shiftR` i | i < 0 = _overflowError | i >= 16 = 0 - | True = x `unsafeShiftR` i + | otherwise = x `unsafeShiftR` i unsafeShiftR = bini16 primWordShr bitSizeMaybe _ = Just 16 bitSize _ = 16 @@ -351,14 +390,16 @@ instance Read Word32 where -} instance Enum Word32 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Word32.succ: overflow" else x + 1 + pred x = if x == minBound then error "Word32.pred: underflow" else x - 1 toEnum = w32 . primIntToWord fromEnum = primWordToInt . unW32 - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Word) + enumFromThenTo = coerce (enumFromThenTo @Word) instance Eq Word32 where (==) = cmp32 primWordEQ @@ -379,12 +420,12 @@ instance Bits Word32 where x `shiftL` i | i < 0 = _overflowError | i >= 32 = 0 - | True = x `unsafeShiftL` i + | otherwise = x `unsafeShiftL` i unsafeShiftL = bini32 primWordShl x `shiftR` i | i < 0 = _overflowError | i >= 32 = 0 - | True = x `unsafeShiftR` i + | otherwise = x `unsafeShiftR` i unsafeShiftR = bini32 primWordShr bitSizeMaybe _ = Just 32 bitSize _ = 32 @@ -449,14 +490,16 @@ instance Read Word64 where -} instance Enum Word64 where - succ x = x + 1 - pred x = x - 1 + succ x = if x == maxBound then error "Word64.succ: overflow" else x + 1 + pred x = if x == minBound then error "Word64.pred: underflow" else x - 1 toEnum = w64 . primIntToWord fromEnum = primWordToInt . unW64 - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom n = enumFromTo n maxBound + enumFromThen n m + | m >= n = enumFromThenTo n m maxBound + | otherwise = enumFromThenTo n m minBound + enumFromTo = coerce (enumFromTo @Word) + enumFromThenTo = coerce (enumFromThenTo @Word) instance Eq Word64 where (==) = cmp64 primWordEQ @@ -477,12 +520,12 @@ instance Bits Word64 where x `shiftL` i | i < 0 = _overflowError | i >= 64 = 0 - | True = x `unsafeShiftL` i + | otherwise = x `unsafeShiftL` i unsafeShiftL = bini64 primWordShl x `shiftR` i | i < 0 = _overflowError | i >= 64 = 0 - | True = x `unsafeShiftR` i + | otherwise = x `unsafeShiftR` i unsafeShiftR = bini64 primWordShr bitSizeMaybe _ = Just 64 bitSize _ = 64 diff --git a/lib/Numeric/Natural.hs b/lib/Numeric/Natural.hs index 7db3bebd..c06a73b4 100644 --- a/lib/Numeric/Natural.hs +++ b/lib/Numeric/Natural.hs @@ -3,6 +3,7 @@ module Numeric.Natural , minusNaturalMaybe ) where import Prelude(); import MiniPrelude +import Data.Coerce import Data.Integer import Data.Real import Control.Exception @@ -24,8 +25,16 @@ instance Num Natural where | otherwise = N x instance Enum Natural where + succ n = n + 1 + pred n = n - 1 toEnum = fromInteger . toInteger fromEnum = fromInteger . toInteger + enumFrom = coerce (enumFrom @Integer) + enumFromThen x1 x2 + | x2 >= x1 = coerce (enumFromThen @Integer) x1 x2 + | otherwise = enumFromThenTo x1 x2 0 + enumFromTo = coerce (enumFromTo @Integer) + enumFromThenTo = coerce (enumFromThenTo @Integer) instance Integral Natural where toInteger (N i) = i From 85a51340930c11a83c41a66eb0b9db15896369fe Mon Sep 17 00:00:00 2001 From: konsumlamm Date: Wed, 29 Jan 2025 21:27:21 +0100 Subject: [PATCH 2/2] More `Enum` tests --- tests/Enum.hs | 41 +++++++++++++++++++++++++++++++++++++++++ tests/Enum.ref | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+) diff --git a/tests/Enum.hs b/tests/Enum.hs index f559463d..386362ae 100644 --- a/tests/Enum.hs +++ b/tests/Enum.hs @@ -1,10 +1,22 @@ module Enum(main) where +import Data.Int +import Data.Word +import Numeric.Natural + data T = A | B | C deriving (Bounded, Enum, Show) +printEnumInt :: forall a. (Bounded a, Enum a, Num a, Show a) => IO () +printEnumInt = do + print $ enumFrom @a maxBound + print $ enumFromThen @a (maxBound - 2) maxBound + print $ enumFromTo @a (maxBound - 2) maxBound + print $ enumFromThenTo @a (maxBound - 5) (maxBound - 3) maxBound + main :: IO () main = do + -- derived instance print $ succ A print $ succ B print $ pred B @@ -17,3 +29,32 @@ main = do print [A, B .. C] print [C, B .. A] print ([minBound .. maxBound] :: [T]) + + -- Bool + print [False ..] + print [False, True ..] + + -- Ordering + print [LT ..] + print [LT, EQ ..] + + -- Char + let maxChar = maxBound :: Char + print [maxChar ..] + print [pred maxChar, maxChar ..] + + -- Int, Word + printEnumInt @Int8 + printEnumInt @Int16 + printEnumInt @Int32 + printEnumInt @Word8 + printEnumInt @Word16 + printEnumInt @Word32 + + -- Natural + let bigInt = 2 ^ 64 :: Natural + print [bigInt..bigInt+2] + print $ take 3 [bigInt..] + print [bigInt-2, bigInt..bigInt+2] + print $ take 3 [bigInt-2, bigInt..] + print [10 :: Natural, 5..] diff --git a/tests/Enum.ref b/tests/Enum.ref index 4e132455..96efbcc2 100644 --- a/tests/Enum.ref +++ b/tests/Enum.ref @@ -10,3 +10,38 @@ B [A,B,C] [C,B,A] [A,B,C] +[False,True] +[False,True] +[LT,EQ,GT] +[LT,EQ,GT] +"\1114111" +"\1114110\1114111" +[127] +[125,127] +[125,126,127] +[122,124,126] +[32767] +[32765,32767] +[32765,32766,32767] +[32762,32764,32766] +[2147483647] +[2147483645,2147483647] +[2147483645,2147483646,2147483647] +[2147483642,2147483644,2147483646] +[255] +[253,255] +[253,254,255] +[250,252,254] +[65535] +[65533,65535] +[65533,65534,65535] +[65530,65532,65534] +[4294967295] +[4294967293,4294967295] +[4294967293,4294967294,4294967295] +[4294967290,4294967292,4294967294] +[18446744073709551616,18446744073709551617,18446744073709551618] +[18446744073709551616,18446744073709551617,18446744073709551618] +[18446744073709551614,18446744073709551616,18446744073709551618] +[18446744073709551614,18446744073709551616,18446744073709551618] +[10,5,0]