{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_HADDOCK not-home #-}
#include "MachDeps.h"
module GHC.Enum(
Bounded(..), Enum(..),
boundedEnumFrom, boundedEnumFromThen,
toEnumError, fromEnumError, succError, predError,
) where
import GHC.Base hiding ( many )
import GHC.Char
import GHC.Integer
import GHC.Num
import GHC.Show
default ()
class Bounded a where
minBound, maxBound :: a
class Enum a where
succ :: a -> a
pred :: a -> a
toEnum :: Int -> a
:: a -> Int
enumFrom :: a -> [a]
enumFromThen :: a -> a -> [a]
enumFromTo :: a -> a -> [a]
enumFromThenTo :: a -> a -> a -> [a]
succ = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (a -> Int) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int -> Int) -> (a -> Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum
pred = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (a -> Int) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract 1) (Int -> Int) -> (a -> Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum
enumFrom x :: a
x = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [a -> Int
forall a. Enum a => a -> Int
fromEnum a
x ..]
enumFromThen x :: a
x y :: a
y = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [a -> Int
forall a. Enum a => a -> Int
fromEnum a
x, a -> Int
forall a. Enum a => a -> Int
fromEnum a
y ..]
enumFromTo x :: a
x y :: a
y = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [a -> Int
forall a. Enum a => a -> Int
fromEnum a
x .. a -> Int
forall a. Enum a => a -> Int
fromEnum a
y]
enumFromThenTo x1 :: a
x1 x2 :: a
x2 y :: a
y = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [a -> Int
forall a. Enum a => a -> Int
fromEnum a
x1, a -> Int
forall a. Enum a => a -> Int
fromEnum a
x2 .. a -> Int
forall a. Enum a => a -> Int
fromEnum a
y]
boundedEnumFrom :: (Enum a, Bounded a) => a -> [a]
boundedEnumFrom :: a -> [a]
boundedEnumFrom n :: a
n = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [a -> Int
forall a. Enum a => a -> Int
fromEnum a
n .. a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
n)]
boundedEnumFromThen :: (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen :: a -> a -> [a]
boundedEnumFromThen n1 :: a
n1 n2 :: a
n2
| Int
i_n2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i_n1 = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [Int
i_n1, Int
i_n2 .. a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
n1)]
| Bool
otherwise = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [Int
i_n1, Int
i_n2 .. a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
n1)]
where
i_n1 :: Int
i_n1 = a -> Int
forall a. Enum a => a -> Int
fromEnum a
n1
i_n2 :: Int
i_n2 = a -> Int
forall a. Enum a => a -> Int
fromEnum a
n2
{-# NOINLINE toEnumError #-}
toEnumError :: (Show a) => String -> Int -> (a,a) -> b
toEnumError :: String -> Int -> (a, a) -> b
toEnumError inst_ty :: String
inst_ty i :: Int
i bnds :: (a, a)
bnds =
String -> b
forall a. String -> a
errorWithoutStackTrace (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ "Enum.toEnum{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inst_ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}: tag (" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
") is outside of bounds " String -> String -> String
forall a. [a] -> [a] -> [a]
++
(a, a) -> String
forall a. Show a => a -> String
show (a, a)
bnds
{-# NOINLINE fromEnumError #-}
fromEnumError :: (Show a) => String -> a -> b
inst_ty :: String
inst_ty x :: a
x =
String -> b
forall a. String -> a
errorWithoutStackTrace (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ "Enum.fromEnum{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inst_ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}: value (" String -> String -> String
forall a. [a] -> [a] -> [a]
++
a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++
") is outside of Int's bounds " String -> String -> String
forall a. [a] -> [a] -> [a]
++
(Int, Int) -> String
forall a. Show a => a -> String
show (Int
forall a. Bounded a => a
minBound::Int, Int
forall a. Bounded a => a
maxBound::Int)
{-# NOINLINE succError #-}
succError :: String -> a
succError :: String -> a
succError inst_ty :: String
inst_ty =
String -> a
forall a. String -> a
errorWithoutStackTrace (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Enum.succ{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inst_ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}: tried to take `succ' of maxBound"
{-# NOINLINE predError #-}
predError :: String -> a
predError :: String -> a
predError inst_ty :: String
inst_ty =
String -> a
forall a. String -> a
errorWithoutStackTrace (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Enum.pred{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inst_ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}: tried to take `pred' of minBound"
deriving instance Bounded ()
instance Enum () where
succ :: () -> ()
succ _ = String -> ()
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.().succ: bad argument"
pred :: () -> ()
pred _ = String -> ()
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.().pred: bad argument"
toEnum :: Int -> ()
toEnum x :: Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ()
| Bool
otherwise = String -> ()
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.().toEnum: bad argument"
fromEnum :: () -> Int
fromEnum () = 0
enumFrom :: () -> [()]
enumFrom () = [()]
enumFromThen :: () -> () -> [()]
enumFromThen () () = let many :: [()]
many = ()() -> [()] -> [()]
forall a. a -> [a] -> [a]
:[()]
many in [()]
many
enumFromTo :: () -> () -> [()]
enumFromTo () () = [()]
enumFromThenTo :: () -> () -> () -> [()]
enumFromThenTo () () () = let many :: [()]
many = ()() -> [()] -> [()]
forall a. a -> [a] -> [a]
:[()]
many in [()]
many
deriving instance (Bounded a, Bounded b)
=> Bounded (a,b)
deriving instance (Bounded a, Bounded b, Bounded c)
=> Bounded (a,b,c)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d)
=> Bounded (a,b,c,d)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e)
=> Bounded (a,b,c,d,e)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f)
=> Bounded (a,b,c,d,e,f)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g)
=> Bounded (a,b,c,d,e,f,g)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h)
=> Bounded (a,b,c,d,e,f,g,h)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h, Bounded i)
=> Bounded (a,b,c,d,e,f,g,h,i)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h, Bounded i, Bounded j)
=> Bounded (a,b,c,d,e,f,g,h,i,j)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k)
=> Bounded (a,b,c,d,e,f,g,h,i,j,k)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,
Bounded l)
=> Bounded (a,b,c,d,e,f,g,h,i,j,k,l)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,
Bounded l, Bounded m)
=> Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,
Bounded l, Bounded m, Bounded n)
=> Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,
Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,
Bounded l, Bounded m, Bounded n, Bounded o)
=> Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
deriving instance Bounded Bool
instance Enum Bool where
succ :: Bool -> Bool
succ False = Bool
True
succ True = String -> Bool
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.Bool.succ: bad argument"
pred :: Bool -> Bool
pred True = Bool
False
pred False = String -> Bool
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.Bool.pred: bad argument"
toEnum :: Int -> Bool
toEnum n :: Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Bool
False
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Bool
True
| Bool
otherwise = String -> Bool
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.Bool.toEnum: bad argument"
fromEnum :: Bool -> Int
fromEnum False = 0
fromEnum True = 1
enumFrom :: Bool -> [Bool]
enumFrom = Bool -> [Bool]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
enumFromThen :: Bool -> Bool -> [Bool]
enumFromThen = Bool -> Bool -> [Bool]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen
deriving instance Bounded Ordering
instance Enum Ordering where
succ :: Ordering -> Ordering
succ LT = Ordering
EQ
succ EQ = Ordering
GT
succ GT = String -> Ordering
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.Ordering.succ: bad argument"
pred :: Ordering -> Ordering
pred GT = Ordering
EQ
pred EQ = Ordering
LT
pred LT = String -> Ordering
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.Ordering.pred: bad argument"
toEnum :: Int -> Ordering
toEnum n :: Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Ordering
LT
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Ordering
EQ
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 = Ordering
GT
toEnum _ = String -> Ordering
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.Ordering.toEnum: bad argument"
fromEnum :: Ordering -> Int
fromEnum LT = 0
fromEnum EQ = 1
fromEnum GT = 2
enumFrom :: Ordering -> [Ordering]
enumFrom = Ordering -> [Ordering]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
enumFromThen :: Ordering -> Ordering -> [Ordering]
enumFromThen = Ordering -> Ordering -> [Ordering]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen
instance Bounded Char where
minBound :: Char
minBound = '\0'
maxBound :: Char
maxBound = '\x10FFFF'
instance Enum Char where
succ :: Char -> Char
succ (C# c# :: Char#
c#)
| Int# -> Bool
isTrue# (Char# -> Int#
ord# Char#
c# Int# -> Int# -> Int#
/=# 0x10FFFF#) = Char# -> Char
C# (Int# -> Char#
chr# (Char# -> Int#
ord# Char#
c# Int# -> Int# -> Int#
+# 1#))
| Bool
otherwise = String -> Char
forall a. String -> a
errorWithoutStackTrace ("Prelude.Enum.Char.succ: bad argument")
pred :: Char -> Char
pred (C# c# :: Char#
c#)
| Int# -> Bool
isTrue# (Char# -> Int#
ord# Char#
c# Int# -> Int# -> Int#
/=# 0#) = Char# -> Char
C# (Int# -> Char#
chr# (Char# -> Int#
ord# Char#
c# Int# -> Int# -> Int#
-# 1#))
| Bool
otherwise = String -> Char
forall a. String -> a
errorWithoutStackTrace ("Prelude.Enum.Char.pred: bad argument")
toEnum :: Int -> Char
toEnum = Int -> Char
chr
fromEnum :: Char -> Int
fromEnum = Char -> Int
ord
{-# INLINE enumFrom #-}
enumFrom :: Char -> String
enumFrom (C# x :: Char#
x) = Int# -> Int# -> String
eftChar (Char# -> Int#
ord# Char#
x) 0x10FFFF#
{-# INLINE enumFromTo #-}
enumFromTo :: Char -> Char -> String
enumFromTo (C# x :: Char#
x) (C# y :: Char#
y) = Int# -> Int# -> String
eftChar (Char# -> Int#
ord# Char#
x) (Char# -> Int#
ord# Char#
y)
{-# INLINE enumFromThen #-}
enumFromThen :: Char -> Char -> String
enumFromThen (C# x1 :: Char#
x1) (C# x2 :: Char#
x2) = Int# -> Int# -> String
efdChar (Char# -> Int#
ord# Char#
x1) (Char# -> Int#
ord# Char#
x2)
{-# INLINE enumFromThenTo #-}
enumFromThenTo :: Char -> Char -> Char -> String
enumFromThenTo (C# x1 :: Char#
x1) (C# x2 :: Char#
x2) (C# y :: Char#
y) = Int# -> Int# -> Int# -> String
efdtChar (Char# -> Int#
ord# Char#
x1) (Char# -> Int#
ord# Char#
x2) (Char# -> Int#
ord# Char#
y)
{-# RULES
"eftChar" [~1] forall x y. eftChar x y = build (\c n -> eftCharFB c n x y)
"efdChar" [~1] forall x1 x2. efdChar x1 x2 = build (\ c n -> efdCharFB c n x1 x2)
"efdtChar" [~1] forall x1 x2 l. efdtChar x1 x2 l = build (\ c n -> efdtCharFB c n x1 x2 l)
"eftCharList" [1] eftCharFB (:) [] = eftChar
"efdCharList" [1] efdCharFB (:) [] = efdChar
"efdtCharList" [1] efdtCharFB (:) [] = efdtChar
#-}
{-# INLINE [0] eftCharFB #-}
eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
eftCharFB c :: Char -> a -> a
c n :: a
n x0 :: Int#
x0 y :: Int#
y = Int# -> a
go Int#
x0
where
go :: Int# -> a
go x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
># Int#
y) = a
n
| Bool
otherwise = Char# -> Char
C# (Int# -> Char#
chr# Int#
x) Char -> a -> a
`c` Int# -> a
go (Int#
x Int# -> Int# -> Int#
+# 1#)
{-# NOINLINE [1] eftChar #-}
eftChar :: Int# -> Int# -> String
eftChar :: Int# -> Int# -> String
eftChar x :: Int#
x y :: Int#
y | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
># Int#
y ) = []
| Bool
otherwise = Char# -> Char
C# (Int# -> Char#
chr# Int#
x) Char -> String -> String
forall a. a -> [a] -> [a]
: Int# -> Int# -> String
eftChar (Int#
x Int# -> Int# -> Int#
+# 1#) Int#
y
{-# INLINE [0] efdCharFB #-}
efdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
efdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
efdCharFB c :: Char -> a -> a
c n :: a
n x1 :: Int#
x1 x2 :: Int#
x2
| Int# -> Bool
isTrue# (Int#
delta Int# -> Int# -> Int#
>=# 0#) = (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
forall a. (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_up_char_fb Char -> a -> a
c a
n Int#
x1 Int#
delta 0x10FFFF#
| Bool
otherwise = (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
forall a. (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_dn_char_fb Char -> a -> a
c a
n Int#
x1 Int#
delta 0#
where
!delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
{-# NOINLINE [1] efdChar #-}
efdChar :: Int# -> Int# -> String
efdChar :: Int# -> Int# -> String
efdChar x1 :: Int#
x1 x2 :: Int#
x2
| Int# -> Bool
isTrue# (Int#
delta Int# -> Int# -> Int#
>=# 0#) = Int# -> Int# -> Int# -> String
go_up_char_list Int#
x1 Int#
delta 0x10FFFF#
| Bool
otherwise = Int# -> Int# -> Int# -> String
go_dn_char_list Int#
x1 Int#
delta 0#
where
!delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
{-# INLINE [0] efdtCharFB #-}
efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
efdtCharFB c :: Char -> a -> a
c n :: a
n x1 :: Int#
x1 x2 :: Int#
x2 lim :: Int#
lim
| Int# -> Bool
isTrue# (Int#
delta Int# -> Int# -> Int#
>=# 0#) = (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
forall a. (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_up_char_fb Char -> a -> a
c a
n Int#
x1 Int#
delta Int#
lim
| Bool
otherwise = (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
forall a. (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_dn_char_fb Char -> a -> a
c a
n Int#
x1 Int#
delta Int#
lim
where
!delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
{-# NOINLINE [1] efdtChar #-}
efdtChar :: Int# -> Int# -> Int# -> String
efdtChar :: Int# -> Int# -> Int# -> String
efdtChar x1 :: Int#
x1 x2 :: Int#
x2 lim :: Int#
lim
| Int# -> Bool
isTrue# (Int#
delta Int# -> Int# -> Int#
>=# 0#) = Int# -> Int# -> Int# -> String
go_up_char_list Int#
x1 Int#
delta Int#
lim
| Bool
otherwise = Int# -> Int# -> Int# -> String
go_dn_char_list Int#
x1 Int#
delta Int#
lim
where
!delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_up_char_fb c :: Char -> a -> a
c n :: a
n x0 :: Int#
x0 delta :: Int#
delta lim :: Int#
lim
= Int# -> a
go_up Int#
x0
where
go_up :: Int# -> a
go_up x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
># Int#
lim) = a
n
| Bool
otherwise = Char# -> Char
C# (Int# -> Char#
chr# Int#
x) Char -> a -> a
`c` Int# -> a
go_up (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
go_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
go_dn_char_fb c :: Char -> a -> a
c n :: a
n x0 :: Int#
x0 delta :: Int#
delta lim :: Int#
lim
= Int# -> a
go_dn Int#
x0
where
go_dn :: Int# -> a
go_dn x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
<# Int#
lim) = a
n
| Bool
otherwise = Char# -> Char
C# (Int# -> Char#
chr# Int#
x) Char -> a -> a
`c` Int# -> a
go_dn (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
go_up_char_list :: Int# -> Int# -> Int# -> String
go_up_char_list :: Int# -> Int# -> Int# -> String
go_up_char_list x0 :: Int#
x0 delta :: Int#
delta lim :: Int#
lim
= Int# -> String
go_up Int#
x0
where
go_up :: Int# -> String
go_up x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
># Int#
lim) = []
| Bool
otherwise = Char# -> Char
C# (Int# -> Char#
chr# Int#
x) Char -> String -> String
forall a. a -> [a] -> [a]
: Int# -> String
go_up (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
go_dn_char_list :: Int# -> Int# -> Int# -> String
go_dn_char_list :: Int# -> Int# -> Int# -> String
go_dn_char_list x0 :: Int#
x0 delta :: Int#
delta lim :: Int#
lim
= Int# -> String
go_dn Int#
x0
where
go_dn :: Int# -> String
go_dn x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
<# Int#
lim) = []
| Bool
otherwise = Char# -> Char
C# (Int# -> Char#
chr# Int#
x) Char -> String -> String
forall a. a -> [a] -> [a]
: Int# -> String
go_dn (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
instance Bounded Int where
minBound :: Int
minBound = Int
minInt
maxBound :: Int
maxBound = Int
maxInt
instance Enum Int where
succ :: Int -> Int
succ x :: Int
x
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound = String -> Int
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
| Bool
otherwise = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
pred :: Int -> Int
pred x :: Int
x
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = String -> Int
forall a. String -> a
errorWithoutStackTrace "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
| Bool
otherwise = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
toEnum :: Int -> Int
toEnum x :: Int
x = Int
x
fromEnum :: Int -> Int
fromEnum x :: Int
x = Int
x
{-# INLINE enumFrom #-}
enumFrom :: Int -> [Int]
enumFrom (I# x :: Int#
x) = Int# -> Int# -> [Int]
eftInt Int#
x Int#
maxInt#
where !(I# maxInt# :: Int#
maxInt#) = Int
maxInt
{-# INLINE enumFromTo #-}
enumFromTo :: Int -> Int -> [Int]
enumFromTo (I# x :: Int#
x) (I# y :: Int#
y) = Int# -> Int# -> [Int]
eftInt Int#
x Int#
y
{-# INLINE enumFromThen #-}
enumFromThen :: Int -> Int -> [Int]
enumFromThen (I# x1 :: Int#
x1) (I# x2 :: Int#
x2) = Int# -> Int# -> [Int]
efdInt Int#
x1 Int#
x2
{-# INLINE enumFromThenTo #-}
enumFromThenTo :: Int -> Int -> Int -> [Int]
enumFromThenTo (I# x1 :: Int#
x1) (I# x2 :: Int#
x2) (I# y :: Int#
y) = Int# -> Int# -> Int# -> [Int]
efdtInt Int#
x1 Int#
x2 Int#
y
{-# RULES
"eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
"eftIntList" [1] eftIntFB (:) [] = eftInt
#-}
{-# NOINLINE [1] eftInt #-}
eftInt :: Int# -> Int# -> [Int]
eftInt :: Int# -> Int# -> [Int]
eftInt x0 :: Int#
x0 y :: Int#
y | Int# -> Bool
isTrue# (Int#
x0 Int# -> Int# -> Int#
># Int#
y) = []
| Bool
otherwise = Int# -> [Int]
go Int#
x0
where
go :: Int# -> [Int]
go x :: Int#
x = Int# -> Int
I# Int#
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: if Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
==# Int#
y)
then []
else Int# -> [Int]
go (Int#
x Int# -> Int# -> Int#
+# 1#)
{-# INLINE [0] eftIntFB #-}
eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
eftIntFB c :: Int -> r -> r
c n :: r
n x0 :: Int#
x0 y :: Int#
y | Int# -> Bool
isTrue# (Int#
x0 Int# -> Int# -> Int#
># Int#
y) = r
n
| Bool
otherwise = Int# -> r
go Int#
x0
where
go :: Int# -> r
go x :: Int#
x = Int# -> Int
I# Int#
x Int -> r -> r
`c` if Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
==# Int#
y)
then r
n
else Int# -> r
go (Int#
x Int# -> Int# -> Int#
+# 1#)
{-# RULES
"efdtInt" [~1] forall x1 x2 y.
efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y)
"efdtIntUpList" [1] efdtIntFB (:) [] = efdtInt
#-}
efdInt :: Int# -> Int# -> [Int]
efdInt :: Int# -> Int# -> [Int]
efdInt x1 :: Int#
x1 x2 :: Int#
x2
| Int# -> Bool
isTrue# (Int#
x2 Int# -> Int# -> Int#
>=# Int#
x1) = case Int
maxInt of I# y :: Int#
y -> Int# -> Int# -> Int# -> [Int]
efdtIntUp Int#
x1 Int#
x2 Int#
y
| Bool
otherwise = case Int
minInt of I# y :: Int#
y -> Int# -> Int# -> Int# -> [Int]
efdtIntDn Int#
x1 Int#
x2 Int#
y
{-# NOINLINE [1] efdtInt #-}
efdtInt :: Int# -> Int# -> Int# -> [Int]
efdtInt :: Int# -> Int# -> Int# -> [Int]
efdtInt x1 :: Int#
x1 x2 :: Int#
x2 y :: Int#
y
| Int# -> Bool
isTrue# (Int#
x2 Int# -> Int# -> Int#
>=# Int#
x1) = Int# -> Int# -> Int# -> [Int]
efdtIntUp Int#
x1 Int#
x2 Int#
y
| Bool
otherwise = Int# -> Int# -> Int# -> [Int]
efdtIntDn Int#
x1 Int#
x2 Int#
y
{-# INLINE [0] efdtIntFB #-}
efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntFB c :: Int -> r -> r
c n :: r
n x1 :: Int#
x1 x2 :: Int#
x2 y :: Int#
y
| Int# -> Bool
isTrue# (Int#
x2 Int# -> Int# -> Int#
>=# Int#
x1) = (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
forall r. (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntUpFB Int -> r -> r
c r
n Int#
x1 Int#
x2 Int#
y
| Bool
otherwise = (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
forall r. (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntDnFB Int -> r -> r
c r
n Int#
x1 Int#
x2 Int#
y
efdtIntUp :: Int# -> Int# -> Int# -> [Int]
efdtIntUp :: Int# -> Int# -> Int# -> [Int]
efdtIntUp x1 :: Int#
x1 x2 :: Int#
x2 y :: Int#
y
| Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
<# Int#
x2) = if Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
<# Int#
x1) then [] else [Int# -> Int
I# Int#
x1]
| Bool
otherwise =
let !delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
!y' :: Int#
y' = Int#
y Int# -> Int# -> Int#
-# Int#
delta
go_up :: Int# -> [Int]
go_up x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
># Int#
y') = [Int# -> Int
I# Int#
x]
| Bool
otherwise = Int# -> Int
I# Int#
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int# -> [Int]
go_up (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
in Int# -> Int
I# Int#
x1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int# -> [Int]
go_up Int#
x2
{-# INLINE [0] efdtIntUpFB #-}
efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntUpFB c :: Int -> r -> r
c n :: r
n x1 :: Int#
x1 x2 :: Int#
x2 y :: Int#
y
| Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
<# Int#
x2) = if Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
<# Int#
x1) then r
n else Int# -> Int
I# Int#
x1 Int -> r -> r
`c` r
n
| Bool
otherwise =
let !delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
!y' :: Int#
y' = Int#
y Int# -> Int# -> Int#
-# Int#
delta
go_up :: Int# -> r
go_up x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
># Int#
y') = Int# -> Int
I# Int#
x Int -> r -> r
`c` r
n
| Bool
otherwise = Int# -> Int
I# Int#
x Int -> r -> r
`c` Int# -> r
go_up (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
in Int# -> Int
I# Int#
x1 Int -> r -> r
`c` Int# -> r
go_up Int#
x2
efdtIntDn :: Int# -> Int# -> Int# -> [Int]
efdtIntDn :: Int# -> Int# -> Int# -> [Int]
efdtIntDn x1 :: Int#
x1 x2 :: Int#
x2 y :: Int#
y
| Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
># Int#
x2) = if Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
># Int#
x1) then [] else [Int# -> Int
I# Int#
x1]
| Bool
otherwise =
let !delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
!y' :: Int#
y' = Int#
y Int# -> Int# -> Int#
-# Int#
delta
go_dn :: Int# -> [Int]
go_dn x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
<# Int#
y') = [Int# -> Int
I# Int#
x]
| Bool
otherwise = Int# -> Int
I# Int#
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int# -> [Int]
go_dn (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
in Int# -> Int
I# Int#
x1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int# -> [Int]
go_dn Int#
x2
{-# INLINE [0] efdtIntDnFB #-}
efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntDnFB c :: Int -> r -> r
c n :: r
n x1 :: Int#
x1 x2 :: Int#
x2 y :: Int#
y
| Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
># Int#
x2) = if Int# -> Bool
isTrue# (Int#
y Int# -> Int# -> Int#
># Int#
x1) then r
n else Int# -> Int
I# Int#
x1 Int -> r -> r
`c` r
n
| Bool
otherwise =
let !delta :: Int#
delta = Int#
x2 Int# -> Int# -> Int#
-# Int#
x1
!y' :: Int#
y' = Int#
y Int# -> Int# -> Int#
-# Int#
delta
go_dn :: Int# -> r
go_dn x :: Int#
x | Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
<# Int#
y') = Int# -> Int
I# Int#
x Int -> r -> r
`c` r
n
| Bool
otherwise = Int# -> Int
I# Int#
x Int -> r -> r
`c` Int# -> r
go_dn (Int#
x Int# -> Int# -> Int#
+# Int#
delta)
in Int# -> Int
I# Int#
x1 Int -> r -> r
`c` Int# -> r
go_dn Int#
x2
instance Bounded Word where
minBound :: Word
minBound = 0
#if WORD_SIZE_IN_BITS == 32
maxBound = W# 0xFFFFFFFF##
#elif WORD_SIZE_IN_BITS == 64
maxBound :: Word
maxBound = Word# -> Word
W# 0xFFFFFFFFFFFFFFFF##
#else
#error Unhandled value for WORD_SIZE_IN_BITS
#endif
instance Enum Word where
succ :: Word -> Word
succ x :: Word
x
| Word
x Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
forall a. Bounded a => a
maxBound = Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1
| Bool
otherwise = String -> Word
forall a. String -> a
succError "Word"
pred :: Word -> Word
pred x :: Word
x
| Word
x Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
forall a. Bounded a => a
minBound = Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
| Bool
otherwise = String -> Word
forall a. String -> a
predError "Word"
toEnum :: Int -> Word
toEnum i :: Int
i@(I# i# :: Int#
i#)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = Word# -> Word
W# (Int# -> Word#
int2Word# Int#
i#)
| Bool
otherwise = String -> Int -> (Word, Word) -> Word
forall a b. Show a => String -> Int -> (a, a) -> b
toEnumError "Word" Int
i (Word
forall a. Bounded a => a
minBound::Word, Word
forall a. Bounded a => a
maxBound::Word)
fromEnum :: Word -> Int
fromEnum x :: Word
x@(W# x# :: Word#
x#)
| Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
maxIntWord = Int# -> Int
I# (Word# -> Int#
word2Int# Word#
x#)
| Bool
otherwise = String -> Word -> Int
forall a b. Show a => String -> a -> b
fromEnumError "Word" Word
x
{-# INLINE enumFrom #-}
enumFrom :: Word -> [Word]
enumFrom (W# x# :: Word#
x#) = Word# -> Word# -> [Word]
eftWord Word#
x# Word#
maxWord#
where !(W# maxWord# :: Word#
maxWord#) = Word
forall a. Bounded a => a
maxBound
{-# INLINE enumFromTo #-}
enumFromTo :: Word -> Word -> [Word]
enumFromTo (W# x :: Word#
x) (W# y :: Word#
y) = Word# -> Word# -> [Word]
eftWord Word#
x Word#
y
{-# INLINE enumFromThen #-}
enumFromThen :: Word -> Word -> [Word]
enumFromThen (W# x1 :: Word#
x1) (W# x2 :: Word#
x2) = Word# -> Word# -> [Word]
efdWord Word#
x1 Word#
x2
{-# INLINE enumFromThenTo #-}
enumFromThenTo :: Word -> Word -> Word -> [Word]
enumFromThenTo (W# x1 :: Word#
x1) (W# x2 :: Word#
x2) (W# y :: Word#
y) = Word# -> Word# -> Word# -> [Word]
efdtWord Word#
x1 Word#
x2 Word#
y
maxIntWord :: Word
maxIntWord :: Word
maxIntWord = Word# -> Word
W# (case Int
maxInt of I# i :: Int#
i -> Int# -> Word#
int2Word# Int#
i)
{-# RULES
"eftWord" [~1] forall x y. eftWord x y = build (\ c n -> eftWordFB c n x y)
"eftWordList" [1] eftWordFB (:) [] = eftWord
#-}
{-# NOINLINE [1] eftWord #-}
eftWord :: Word# -> Word# -> [Word]
eftWord :: Word# -> Word# -> [Word]
eftWord x0 :: Word#
x0 y :: Word#
y | Int# -> Bool
isTrue# (Word#
x0 Word# -> Word# -> Int#
`gtWord#` Word#
y) = []
| Bool
otherwise = Word# -> [Word]
go Word#
x0
where
go :: Word# -> [Word]
go x :: Word#
x = Word# -> Word
W# Word#
x Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: if Int# -> Bool
isTrue# (Word#
x Word# -> Word# -> Int#
`eqWord#` Word#
y)
then []
else Word# -> [Word]
go (Word#
x Word# -> Word# -> Word#
`plusWord#` 1##)
{-# INLINE [0] eftWordFB #-}
eftWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> r
eftWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> r
eftWordFB c :: Word -> r -> r
c n :: r
n x0 :: Word#
x0 y :: Word#
y | Int# -> Bool
isTrue# (Word#
x0 Word# -> Word# -> Int#
`gtWord#` Word#
y) = r
n
| Bool
otherwise = Word# -> r
go Word#
x0
where
go :: Word# -> r
go x :: Word#
x = Word# -> Word
W# Word#
x Word -> r -> r
`c` if Int# -> Bool
isTrue# (Word#
x Word# -> Word# -> Int#
`eqWord#` Word#
y)
then r
n
else Word# -> r
go (Word#
x Word# -> Word# -> Word#
`plusWord#` 1##)
{-# RULES
"efdtWord" [~1] forall x1 x2 y.
efdtWord x1 x2 y = build (\ c n -> efdtWordFB c n x1 x2 y)
"efdtWordUpList" [1] efdtWordFB (:) [] = efdtWord
#-}
efdWord :: Word# -> Word# -> [Word]
efdWord :: Word# -> Word# -> [Word]
efdWord x1 :: Word#
x1 x2 :: Word#
x2
| Int# -> Bool
isTrue# (Word#
x2 Word# -> Word# -> Int#
`geWord#` Word#
x1) = case Word
forall a. Bounded a => a
maxBound of W# y :: Word#
y -> Word# -> Word# -> Word# -> [Word]
efdtWordUp Word#
x1 Word#
x2 Word#
y
| Bool
otherwise = case Word
forall a. Bounded a => a
minBound of W# y :: Word#
y -> Word# -> Word# -> Word# -> [Word]
efdtWordDn Word#
x1 Word#
x2 Word#
y
{-# NOINLINE [1] efdtWord #-}
efdtWord :: Word# -> Word# -> Word# -> [Word]
efdtWord :: Word# -> Word# -> Word# -> [Word]
efdtWord x1 :: Word#
x1 x2 :: Word#
x2 y :: Word#
y
| Int# -> Bool
isTrue# (Word#
x2 Word# -> Word# -> Int#
`geWord#` Word#
x1) = Word# -> Word# -> Word# -> [Word]
efdtWordUp Word#
x1 Word#
x2 Word#
y
| Bool
otherwise = Word# -> Word# -> Word# -> [Word]
efdtWordDn Word#
x1 Word#
x2 Word#
y
{-# INLINE [0] efdtWordFB #-}
efdtWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordFB c :: Word -> r -> r
c n :: r
n x1 :: Word#
x1 x2 :: Word#
x2 y :: Word#
y
| Int# -> Bool
isTrue# (Word#
x2 Word# -> Word# -> Int#
`geWord#` Word#
x1) = (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
forall r. (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordUpFB Word -> r -> r
c r
n Word#
x1 Word#
x2 Word#
y
| Bool
otherwise = (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
forall r. (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordDnFB Word -> r -> r
c r
n Word#
x1 Word#
x2 Word#
y
efdtWordUp :: Word# -> Word# -> Word# -> [Word]
efdtWordUp :: Word# -> Word# -> Word# -> [Word]
efdtWordUp x1 :: Word#
x1 x2 :: Word#
x2 y :: Word#
y
| Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`ltWord#` Word#
x2) = if Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`ltWord#` Word#
x1) then [] else [Word# -> Word
W# Word#
x1]
| Bool
otherwise =
let !delta :: Word#
delta = Word#
x2 Word# -> Word# -> Word#
`minusWord#` Word#
x1
!y' :: Word#
y' = Word#
y Word# -> Word# -> Word#
`minusWord#` Word#
delta
go_up :: Word# -> [Word]
go_up x :: Word#
x | Int# -> Bool
isTrue# (Word#
x Word# -> Word# -> Int#
`gtWord#` Word#
y') = [Word# -> Word
W# Word#
x]
| Bool
otherwise = Word# -> Word
W# Word#
x Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Word# -> [Word]
go_up (Word#
x Word# -> Word# -> Word#
`plusWord#` Word#
delta)
in Word# -> Word
W# Word#
x1 Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Word# -> [Word]
go_up Word#
x2
{-# INLINE [0] efdtWordUpFB #-}
efdtWordUpFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordUpFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordUpFB c :: Word -> r -> r
c n :: r
n x1 :: Word#
x1 x2 :: Word#
x2 y :: Word#
y
| Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`ltWord#` Word#
x2) = if Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`ltWord#` Word#
x1) then r
n else Word# -> Word
W# Word#
x1 Word -> r -> r
`c` r
n
| Bool
otherwise =
let !delta :: Word#
delta = Word#
x2 Word# -> Word# -> Word#
`minusWord#` Word#
x1
!y' :: Word#
y' = Word#
y Word# -> Word# -> Word#
`minusWord#` Word#
delta
go_up :: Word# -> r
go_up x :: Word#
x | Int# -> Bool
isTrue# (Word#
x Word# -> Word# -> Int#
`gtWord#` Word#
y') = Word# -> Word
W# Word#
x Word -> r -> r
`c` r
n
| Bool
otherwise = Word# -> Word
W# Word#
x Word -> r -> r
`c` Word# -> r
go_up (Word#
x Word# -> Word# -> Word#
`plusWord#` Word#
delta)
in Word# -> Word
W# Word#
x1 Word -> r -> r
`c` Word# -> r
go_up Word#
x2
efdtWordDn :: Word# -> Word# -> Word# -> [Word]
efdtWordDn :: Word# -> Word# -> Word# -> [Word]
efdtWordDn x1 :: Word#
x1 x2 :: Word#
x2 y :: Word#
y
| Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`gtWord#` Word#
x2) = if Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`gtWord#` Word#
x1) then [] else [Word# -> Word
W# Word#
x1]
| Bool
otherwise =
let !delta :: Word#
delta = Word#
x2 Word# -> Word# -> Word#
`minusWord#` Word#
x1
!y' :: Word#
y' = Word#
y Word# -> Word# -> Word#
`minusWord#` Word#
delta
go_dn :: Word# -> [Word]
go_dn x :: Word#
x | Int# -> Bool
isTrue# (Word#
x Word# -> Word# -> Int#
`ltWord#` Word#
y') = [Word# -> Word
W# Word#
x]
| Bool
otherwise = Word# -> Word
W# Word#
x Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Word# -> [Word]
go_dn (Word#
x Word# -> Word# -> Word#
`plusWord#` Word#
delta)
in Word# -> Word
W# Word#
x1 Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Word# -> [Word]
go_dn Word#
x2
{-# INLINE [0] efdtWordDnFB #-}
efdtWordDnFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordDnFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r
efdtWordDnFB c :: Word -> r -> r
c n :: r
n x1 :: Word#
x1 x2 :: Word#
x2 y :: Word#
y
| Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`gtWord#` Word#
x2) = if Int# -> Bool
isTrue# (Word#
y Word# -> Word# -> Int#
`gtWord#` Word#
x1) then r
n else Word# -> Word
W# Word#
x1 Word -> r -> r
`c` r
n
| Bool
otherwise =
let !delta :: Word#
delta = Word#
x2 Word# -> Word# -> Word#
`minusWord#` Word#
x1
!y' :: Word#
y' = Word#
y Word# -> Word# -> Word#
`minusWord#` Word#
delta
go_dn :: Word# -> r
go_dn x :: Word#
x | Int# -> Bool
isTrue# (Word#
x Word# -> Word# -> Int#
`ltWord#` Word#
y') = Word# -> Word
W# Word#
x Word -> r -> r
`c` r
n
| Bool
otherwise = Word# -> Word
W# Word#
x Word -> r -> r
`c` Word# -> r
go_dn (Word#
x Word# -> Word# -> Word#
`plusWord#` Word#
delta)
in Word# -> Word
W# Word#
x1 Word -> r -> r
`c` Word# -> r
go_dn Word#
x2
instance Enum Integer where
succ :: Integer -> Integer
succ x :: Integer
x = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
pred :: Integer -> Integer
pred x :: Integer
x = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
toEnum :: Int -> Integer
toEnum (I# n :: Int#
n) = Int# -> Integer
smallInteger Int#
n
fromEnum :: Integer -> Int
fromEnum n :: Integer
n = Int# -> Int
I# (Integer -> Int#
integerToInt Integer
n)
{-# INLINE enumFrom #-}
{-# INLINE enumFromThen #-}
{-# INLINE enumFromTo #-}
{-# INLINE enumFromThenTo #-}
enumFrom :: Integer -> [Integer]
enumFrom x :: Integer
x = Integer -> Integer -> [Integer]
enumDeltaInteger Integer
x 1
enumFromThen :: Integer -> Integer -> [Integer]
enumFromThen x :: Integer
x y :: Integer
y = Integer -> Integer -> [Integer]
enumDeltaInteger Integer
x (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
x)
enumFromTo :: Integer -> Integer -> [Integer]
enumFromTo x :: Integer
x lim :: Integer
lim = Integer -> Integer -> Integer -> [Integer]
enumDeltaToInteger Integer
x 1 Integer
lim
enumFromThenTo :: Integer -> Integer -> Integer -> [Integer]
enumFromThenTo x :: Integer
x y :: Integer
y lim :: Integer
lim = Integer -> Integer -> Integer -> [Integer]
enumDeltaToInteger Integer
x (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
x) Integer
lim
{-# RULES
"enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y)
"efdtInteger" [~1] forall x d l. enumDeltaToInteger x d l = build (\c n -> enumDeltaToIntegerFB c n x d l)
"efdtInteger1" [~1] forall x l. enumDeltaToInteger x 1 l = build (\c n -> enumDeltaToInteger1FB c n x l)
"enumDeltaToInteger1FB" [1] forall c n x. enumDeltaToIntegerFB c n x 1 = enumDeltaToInteger1FB c n x
"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger
"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger
"enumDeltaToInteger1" [1] enumDeltaToInteger1FB (:) [] = enumDeltaToInteger1
#-}
{-# INLINE [0] enumDeltaIntegerFB #-}
enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
enumDeltaIntegerFB c :: Integer -> b -> b
c x0 :: Integer
x0 d :: Integer
d = Integer -> b
go Integer
x0
where go :: Integer -> b
go x :: Integer
x = Integer
x Integer -> b -> b
forall a b. a -> b -> b
`seq` (Integer
x Integer -> b -> b
`c` Integer -> b
go (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
d))
{-# NOINLINE [1] enumDeltaInteger #-}
enumDeltaInteger :: Integer -> Integer -> [Integer]
enumDeltaInteger :: Integer -> Integer -> [Integer]
enumDeltaInteger x :: Integer
x d :: Integer
d = Integer
x Integer -> [Integer] -> [Integer]
forall a b. a -> b -> b
`seq` (Integer
x Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> Integer -> [Integer]
enumDeltaInteger (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
d) Integer
d)
{-# INLINE [0] enumDeltaToIntegerFB #-}
enumDeltaToIntegerFB :: (Integer -> a -> a) -> a
-> Integer -> Integer -> Integer -> a
enumDeltaToIntegerFB :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
enumDeltaToIntegerFB c :: Integer -> a -> a
c n :: a
n x :: Integer
x delta :: Integer
delta lim :: Integer
lim
| Integer
delta Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
forall a.
(Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
up_fb Integer -> a -> a
c a
n Integer
x Integer
delta Integer
lim
| Bool
otherwise = (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
forall a.
(Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
dn_fb Integer -> a -> a
c a
n Integer
x Integer
delta Integer
lim
{-# INLINE [0] enumDeltaToInteger1FB #-}
enumDeltaToInteger1FB :: (Integer -> a -> a) -> a
-> Integer -> Integer -> a
enumDeltaToInteger1FB :: (Integer -> a -> a) -> a -> Integer -> Integer -> a
enumDeltaToInteger1FB c :: Integer -> a -> a
c n :: a
n x0 :: Integer
x0 lim :: Integer
lim = Integer -> a
go (Integer
x0 :: Integer)
where
go :: Integer -> a
go x :: Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
lim = a
n
| Bool
otherwise = Integer
x Integer -> a -> a
`c` Integer -> a
go (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1)
{-# NOINLINE [1] enumDeltaToInteger #-}
enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer]
enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer]
enumDeltaToInteger x :: Integer
x delta :: Integer
delta lim :: Integer
lim
| Integer
delta Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = Integer -> Integer -> Integer -> [Integer]
up_list Integer
x Integer
delta Integer
lim
| Bool
otherwise = Integer -> Integer -> Integer -> [Integer]
dn_list Integer
x Integer
delta Integer
lim
{-# NOINLINE [1] enumDeltaToInteger1 #-}
enumDeltaToInteger1 :: Integer -> Integer -> [Integer]
enumDeltaToInteger1 :: Integer -> Integer -> [Integer]
enumDeltaToInteger1 x0 :: Integer
x0 lim :: Integer
lim = Integer -> [Integer]
go (Integer
x0 :: Integer)
where
go :: Integer -> [Integer]
go x :: Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
lim = []
| Bool
otherwise = Integer
x Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer]
go (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1)
up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
up_fb c :: Integer -> a -> a
c n :: a
n x0 :: Integer
x0 delta :: Integer
delta lim :: Integer
lim = Integer -> a
go (Integer
x0 :: Integer)
where
go :: Integer -> a
go x :: Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
lim = a
n
| Bool
otherwise = Integer
x Integer -> a -> a
`c` Integer -> a
go (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
delta)
dn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
dn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
dn_fb c :: Integer -> a -> a
c n :: a
n x0 :: Integer
x0 delta :: Integer
delta lim :: Integer
lim = Integer -> a
go (Integer
x0 :: Integer)
where
go :: Integer -> a
go x :: Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
lim = a
n
| Bool
otherwise = Integer
x Integer -> a -> a
`c` Integer -> a
go (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
delta)
up_list :: Integer -> Integer -> Integer -> [Integer]
up_list :: Integer -> Integer -> Integer -> [Integer]
up_list x0 :: Integer
x0 delta :: Integer
delta lim :: Integer
lim = Integer -> [Integer]
go (Integer
x0 :: Integer)
where
go :: Integer -> [Integer]
go x :: Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
lim = []
| Bool
otherwise = Integer
x Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer]
go (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
delta)
dn_list :: Integer -> Integer -> Integer -> [Integer]
dn_list :: Integer -> Integer -> Integer -> [Integer]
dn_list x0 :: Integer
x0 delta :: Integer
delta lim :: Integer
lim = Integer -> [Integer]
go (Integer
x0 :: Integer)
where
go :: Integer -> [Integer]
go x :: Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
lim = []
| Bool
otherwise = Integer
x Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer]
go (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
delta)
instance Enum Natural where
succ :: Natural -> Natural
succ n :: Natural
n = Natural
n Natural -> Natural -> Natural
`plusNatural` Word# -> Natural
wordToNaturalBase 1##
pred :: Natural -> Natural
pred n :: Natural
n = Natural
n Natural -> Natural -> Natural
`minusNatural` Word# -> Natural
wordToNaturalBase 1##
toEnum :: Int -> Natural
toEnum = Int -> Natural
intToNatural
#if defined(MIN_VERSION_integer_gmp)
fromEnum :: Natural -> Int
fromEnum (NatS# w :: Word#
w)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = Int
i
| Bool
otherwise = String -> Int
forall a. String -> a
errorWithoutStackTrace "fromEnum: out of Int range"
where
i :: Int
i = Int# -> Int
I# (Word# -> Int#
word2Int# Word#
w)
#endif
fromEnum n :: Natural
n = Integer -> Int
forall a. Enum a => a -> Int
fromEnum (Natural -> Integer
naturalToInteger Natural
n)
enumFrom :: Natural -> [Natural]
enumFrom x :: Natural
x = Natural -> Natural -> [Natural]
enumDeltaNatural Natural
x (Word# -> Natural
wordToNaturalBase 1##)
enumFromThen :: Natural -> Natural -> [Natural]
enumFromThen x :: Natural
x y :: Natural
y
| Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
y = Natural -> Natural -> [Natural]
enumDeltaNatural Natural
x (Natural
yNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
x)
| Bool
otherwise = Natural -> Natural -> Natural -> [Natural]
enumNegDeltaToNatural Natural
x (Natural
xNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
y) (Word# -> Natural
wordToNaturalBase 0##)
enumFromTo :: Natural -> Natural -> [Natural]
enumFromTo x :: Natural
x lim :: Natural
lim = Natural -> Natural -> Natural -> [Natural]
enumDeltaToNatural Natural
x (Word# -> Natural
wordToNaturalBase 1##) Natural
lim
enumFromThenTo :: Natural -> Natural -> Natural -> [Natural]
enumFromThenTo x :: Natural
x y :: Natural
y lim :: Natural
lim
| Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
y = Natural -> Natural -> Natural -> [Natural]
enumDeltaToNatural Natural
x (Natural
yNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
x) Natural
lim
| Bool
otherwise = Natural -> Natural -> Natural -> [Natural]
enumNegDeltaToNatural Natural
x (Natural
xNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
y) Natural
lim
enumDeltaNatural :: Natural -> Natural -> [Natural]
enumDeltaNatural :: Natural -> Natural -> [Natural]
enumDeltaNatural !Natural
x d :: Natural
d = Natural
x Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: Natural -> Natural -> [Natural]
enumDeltaNatural (Natural
xNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
+Natural
d) Natural
d
enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumDeltaToNatural x0 :: Natural
x0 delta :: Natural
delta lim :: Natural
lim = Natural -> [Natural]
go Natural
x0
where
go :: Natural -> [Natural]
go x :: Natural
x | Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
lim = []
| Bool
otherwise = Natural
x Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: Natural -> [Natural]
go (Natural
xNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
+Natural
delta)
enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumNegDeltaToNatural x0 :: Natural
x0 ndelta :: Natural
ndelta lim :: Natural
lim = Natural -> [Natural]
go Natural
x0
where
go :: Natural -> [Natural]
go x :: Natural
x | Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
lim = []
| Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ndelta = Natural
x Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: Natural -> [Natural]
go (Natural
xNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
ndelta)
| Bool
otherwise = [Natural
x]
deriving instance Bounded VecCount
deriving instance Enum VecCount
deriving instance Bounded VecElem
deriving instance Enum VecElem