Merge pull request #116 from konsumlamm/Enum

Fix/improve `Enum` instances

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

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)

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