{-#LANGUAGE TemplateHaskell#-}
module Control.Enumerable
( Enumerable(..)
, datatype, c0, c1, c2, c3, c4, c5, c6, c7
, global, local
, deriveEnumerable
, dAll, dExcluding, dExcept, ConstructorDeriv, deriveEnumerable'
, access, share, Shared, Shareable, Typeable, module Control.Sized
, function, CoEnumerable(..)
, Infinite
)where
import Control.Sized
import Data.ClassSharing
import Data.Modifiers
import Data.Bits
import Data.Word
import Data.Int
import Data.Ratio
import Control.Enumerable.Derive hiding (global)
instance (Typeable f, Sized f) => Sized (Shareable f) where
pay :: forall a. Shareable f a -> Shareable f a
pay = forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Sized f => f a -> f a
pay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run
fin :: Integer -> Shareable f Integer
fin = forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Sized f => Integer -> f Integer
fin
pair :: forall a b. Shareable f a -> Shareable f b -> Shareable f (a, b)
pair Shareable f a
x Shareable f b
y = forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable forall a b. (a -> b) -> a -> b
$ \Ref
r -> forall (f :: * -> *) a b. Sized f => f a -> f b -> f (a, b)
pair (forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run Shareable f a
x Ref
r) (forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run Shareable f b
y Ref
r)
aconcat :: forall a. [Shareable f a] -> Shareable f a
aconcat [Shareable f a]
xs = forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable forall a b. (a -> b) -> a -> b
$ \Ref
r -> forall (f :: * -> *) a. Sized f => [f a] -> f a
aconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a. Shareable f a -> Ref -> f a
`run` Ref
r) [Shareable f a]
xs)
finSized :: Integer -> Shareable f Integer
finSized = forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Sized f => Integer -> f Integer
finSized
naturals :: Shareable f Integer
naturals = forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable (forall a b. a -> b -> a
const forall (f :: * -> *). Sized f => f Integer
naturals)
class Typeable a => Enumerable a where
enumerate :: (Typeable f, Sized f) => Shared f a
access :: (Enumerable a, Sized f, Typeable f) => Shareable f a
access :: forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access = forall (f :: * -> *) a. Shared f a -> Shareable f a
unsafeAccess forall a (f :: * -> *).
(Enumerable a, Typeable f, Sized f) =>
Shared f a
enumerate
{-#INLINE local#-}
local :: (Typeable f, Sized f, Enumerable a) => f a
local :: forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
local = forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access (() -> Ref
unsafeNewRef ())
{-#NOINLINE gref#-}
gref :: Ref
gref :: Ref
gref = () -> Ref
unsafeNewRef ()
global :: (Typeable f, Sized f, Enumerable a) => f a
global :: forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global = forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access Ref
gref
datatype :: (Typeable a, Sized f, Typeable f) => [Shareable f a] -> Shared f a
datatype :: forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Sized f => f a -> f a
pay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Sized f => [f a] -> f a
aconcat
c0 :: Sized f => a -> Shareable f a
c0 :: forall (f :: * -> *) a. Sized f => a -> Shareable f a
c0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure
c1 :: (Enumerable a, Sized f, Typeable f) => (a -> x) -> Shareable f x
c1 :: forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 a -> x
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> x
f forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access
c2 :: (Enumerable a, Enumerable b, Sized f, Typeable f) => (a -> b -> x) -> Shareable f x
c2 :: forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 a -> b -> x
f = forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> x
f)
c3 :: (Enumerable a, Enumerable b, Enumerable c, Sized f, Typeable f) => (a -> b -> c -> x) -> Shareable f x
c3 :: forall a b c (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Sized f, Typeable f) =>
(a -> b -> c -> x) -> Shareable f x
c3 a -> b -> c -> x
f = forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> x
f)
c4 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Sized f, Typeable f) => (a -> b -> c -> d -> x) -> Shareable f x
c4 :: forall a b c d (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d, Sized f,
Typeable f) =>
(a -> b -> c -> d -> x) -> Shareable f x
c4 a -> b -> c -> d -> x
f = forall a b c (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Sized f, Typeable f) =>
(a -> b -> c -> x) -> Shareable f x
c3 (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> x
f)
c5 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Sized f, Typeable f) => (a -> b -> c -> d -> e -> x) -> Shareable f x
c5 :: forall a b c d e (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d,
Enumerable e, Sized f, Typeable f) =>
(a -> b -> c -> d -> e -> x) -> Shareable f x
c5 a -> b -> c -> d -> e -> x
f = forall a b c d (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d, Sized f,
Typeable f) =>
(a -> b -> c -> d -> x) -> Shareable f x
c4 (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> e -> x
f)
c6 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> x) -> Shareable f x
c6 :: forall a b c d e g (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d,
Enumerable e, Enumerable g, Sized f, Typeable f) =>
(a -> b -> c -> d -> e -> g -> x) -> Shareable f x
c6 a -> b -> c -> d -> e -> g -> x
f = forall a b c d e (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d,
Enumerable e, Sized f, Typeable f) =>
(a -> b -> c -> d -> e -> x) -> Shareable f x
c5 (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> e -> g -> x
f)
c7 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Enumerable h, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> h -> x) -> Shareable f x
c7 :: forall a b c d e g h (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d,
Enumerable e, Enumerable g, Enumerable h, Sized f, Typeable f) =>
(a -> b -> c -> d -> e -> g -> h -> x) -> Shareable f x
c7 a -> b -> c -> d -> e -> g -> h -> x
f = forall a b c d e g (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d,
Enumerable e, Enumerable g, Sized f, Typeable f) =>
(a -> b -> c -> d -> e -> g -> x) -> Shareable f x
c6 (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> e -> g -> h -> x
f)
instance Enumerable () where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f ()
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance (Enumerable a, Enumerable b) => Enumerable (a,b) where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f (a, b)
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Sized f => f a -> f b -> f (a, b)
pair forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access
instance (Enumerable a, Enumerable b, Enumerable c) => Enumerable (a,b,c) where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f (a, b, c)
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a b. (a -> b) -> a -> b
$ \(a
a,(b
b,c
c)) -> (a
a,b
b,c
c)
instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d)
=> Enumerable (a,b,c,d) where
enumerate :: forall (f :: * -> *).
(Typeable f, Sized f) =>
Shared f (a, b, c, d)
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a b. (a -> b) -> a -> b
$ \(a
a,(b
b,(c
c,d
d))) -> (a
a,b
b,c
c,d
d)
instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e)
=> Enumerable (a,b,c,d,e) where
enumerate :: forall (f :: * -> *).
(Typeable f, Sized f) =>
Shared f (a, b, c, d, e)
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a b. (a -> b) -> a -> b
$ \(a
a,(b
b,(c
c,(d
d,e
e)))) -> (a
a,b
b,c
c,d
d,e
e)
instance Enumerable Bool where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Bool
enumerate = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False, forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True]
instance (Enumerable a, Enumerable b) => Enumerable (Either a b) where
enumerate :: forall (f :: * -> *).
(Typeable f, Sized f) =>
Shared f (Either a b)
enumerate = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a b. a -> Either a b
Left, forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a b. b -> Either a b
Right]
instance Enumerable a => Enumerable [a] where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f [a]
enumerate = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [forall (f :: * -> *) a. Applicative f => a -> f a
pure [], forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 (:)]
instance Enumerable a => Enumerable (Maybe a) where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f (Maybe a)
enumerate = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing, forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a. a -> Maybe a
Just]
instance Enumerable Ordering where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Ordering
enumerate = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT, forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ, forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT]
instance Enumerable Integer where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Integer
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a. Nat a -> a
nat forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 (\(Nat Integer
n) -> -Integer
nforall a. Num a => a -> a -> a
-Integer
1)
instance Enumerable Word where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Word
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word
instance Enumerable Word8 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Word8
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word
instance Enumerable Word16 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Word16
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word
instance Enumerable Word32 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Word32
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word
instance Enumerable Word64 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Word64
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word
instance Enumerable Int where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Int
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int
instance Enumerable Int8 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Int8
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int
instance Enumerable Int16 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Int16
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int
instance Enumerable Int32 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Int32
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int
instance Enumerable Int64 where enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Int64
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int
instance Enumerable Char where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Char
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Sized f => Int -> f Integer
kbits Int
7
instance Enumerable Float where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Float
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 forall a b. (a -> b) -> a -> b
$ \Int8
b Integer
a -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
a (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
b :: Int8))
instance Enumerable Double where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Double
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Integer -> Int -> a
encodeFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Shareable f Int
e where
e :: Shareable f Int
e = forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded (-Int
1) (-Int
lo) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded Int
0 Int
hi
(Int
lo,Int
hi) = forall a. RealFloat a => a -> (Int, Int)
floatRange (Double
0 :: Double)
class (Typeable a, Integral a) => Infinite a
instance Infinite Integer
instance Infinite a => Enumerable (Ratio a) where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f (Ratio a)
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Integer -> Ratio a
rat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Nat a -> a
nat)
rat :: Integral a => Integer -> Ratio a
rat :: forall a. Integral a => Integer -> Ratio a
rat Integer
i | Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"Index out of bounds"
rat Integer
i = forall {t} {t}. (Integral t, Integral t) => t -> t -> t -> Ratio t
go a
1 a
1 Integer
i where
go :: t -> t -> t -> Ratio t
go t
a t
b t
0 = t
a forall a. Integral a => a -> a -> Ratio a
% t
b
go t
a t
b t
i = let (t
i',t
m) = t
i forall a. Integral a => a -> a -> (a, a)
`divMod` t
2 in if t
m forall a. Eq a => a -> a -> Bool
== t
1 then t -> t -> t -> Ratio t
go (t
aforall a. Num a => a -> a -> a
+t
b) t
b t
i' else t -> t -> t -> Ratio t
go t
a (t
a forall a. Num a => a -> a -> a
+t
b) t
i'
instance Enumerable Unicode where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Unicode
enumerate = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Unicode
Unicode forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded
(forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: Char))
(forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: Char))]
instance Enumerable Printable where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f Printable
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Printable
Printable forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded Int
32 Int
126
enumerateBounded :: (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded :: forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded Int
lo Int
hi = forall {a}. Enum a => Integer -> a
trans forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Sized f => Integer -> f Integer
finSized (forall a. Integral a => a -> Integer
toInteger (Int
hi forall a. Num a => a -> a -> a
- Int
lo)) where
trans :: Integer -> a
trans Integer
i = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger (forall a. Integral a => a -> Integer
toInteger Int
lo forall a. Num a => a -> a -> a
+ Integer
i)
instance Infinite integer => Enumerable (Nat integer) where
enumerate :: forall (f :: * -> *).
(Typeable f, Sized f) =>
Shared f (Nat integer)
enumerate = forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (forall a. a -> Nat a
Nat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Sized f => f Integer
naturals)
instance Enumerable a => Enumerable (NonEmpty a) where
enumerate :: forall (f :: * -> *).
(Typeable f, Sized f) =>
Shared f (NonEmpty a)
enumerate = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> NonEmpty a
mkNonEmpty]
word :: (FiniteBits a, Integral a, Sized f) => f a
word :: forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word = let e :: f a
e = forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Sized f => Int -> f Integer
kbits (forall a (f :: * -> *). FiniteBits a => f a -> Int
bitSize' f a
e) in f a
e
int :: (FiniteBits a, Integral a, Sized f) => f a
int :: forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int = let e :: f a
e = forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Integer
kbs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Integer
n -> forall a. Num a => Integer -> a
fromInteger (-Integer
nforall a. Num a => a -> a -> a
-Integer
1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Integer
kbs
kbs :: f Integer
kbs = forall (f :: * -> *). Sized f => Integer -> f Integer
finSized (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(forall a (f :: * -> *). FiniteBits a => f a -> Int
bitSize' f a
e forall a. Num a => a -> a -> a
- Int
1))
in f a
e
bitSize' :: FiniteBits a => f a -> Int
bitSize' :: forall a (f :: * -> *). FiniteBits a => f a -> Int
bitSize' f a
f = forall a (f :: * -> *). FiniteBits a => a -> f a -> Int
hlp (forall a. HasCallStack => [Char] -> a
error [Char]
"Enumerable: This is not supposed to be inspected") f a
f where
hlp :: FiniteBits a => a -> f a -> Int
hlp :: forall a (f :: * -> *). FiniteBits a => a -> f a -> Int
hlp a
a f a
_ = forall b. FiniteBits b => b -> Int
finiteBitSize a
a
class Typeable a => CoEnumerable a where
coEnumerate :: (Enumerable b,Sized f, Typeable f) => Shared f (a -> b)
function :: (Typeable a, Enumerable b, Sized f, Typeable f) => Shareable f (a -> b) -> Shared f (a -> b)
function :: forall a b (f :: * -> *).
(Typeable a, Enumerable b, Sized f, Typeable f) =>
Shareable f (a -> b) -> Shared f (a -> b)
function Shareable f (a -> b)
f = forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [ forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 forall a b. a -> b -> a
const, Shareable f (a -> b)
f]
instance (CoEnumerable a, Enumerable b) => Enumerable (a -> b) where
enumerate :: forall (f :: * -> *). (Typeable f, Sized f) => Shared f (a -> b)
enumerate = forall a b (f :: * -> *).
(CoEnumerable a, Enumerable b, Sized f, Typeable f) =>
Shared f (a -> b)
coEnumerate
instance CoEnumerable Bool where
coEnumerate :: forall b (f :: * -> *).
(Enumerable b, Sized f, Typeable f) =>
Shared f (Bool -> b)
coEnumerate = forall a b (f :: * -> *).
(Typeable a, Enumerable b, Sized f, Typeable f) =>
Shareable f (a -> b) -> Shared f (a -> b)
function forall a b. (a -> b) -> a -> b
$ forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 forall a b. (a -> b) -> a -> b
$ \b
x b
y Bool
b -> if Bool
b then b
x else b
y
instance CoEnumerable a => CoEnumerable [a] where
coEnumerate :: forall b (f :: * -> *).
(Enumerable b, Sized f, Typeable f) =>
Shared f ([a] -> b)
coEnumerate = forall a b (f :: * -> *).
(Typeable a, Enumerable b, Sized f, Typeable f) =>
Shareable f (a -> b) -> Shared f (a -> b)
function forall a b. (a -> b) -> a -> b
$ forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 forall a b. (a -> b) -> a -> b
$
\b
uf a -> [a] -> b
cf [a]
xs -> case [a]
xs of
[] -> b
uf
(a
x:[a]
xs) -> a -> [a] -> b
cf a
x [a]
xs
deriveEnumerable :: Name -> Q [Dec]
deriveEnumerable :: Name -> Q [Dec]
deriveEnumerable = ConstructorDeriv -> Q [Dec]
deriveEnumerable' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ConstructorDeriv
dAll
type ConstructorDeriv = (Name, [(Name, ExpQ)])
dAll :: Name -> ConstructorDeriv
dAll :: Name -> ConstructorDeriv
dAll Name
n = (Name
n,[])
dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv
dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv
dExcluding Name
n (Name
t,[(Name, ExpQ)]
nrs) = (Name
t,(Name
n,[|empty|])forall a. a -> [a] -> [a]
:[(Name, ExpQ)]
nrs)
dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv
dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv
dExcept Name
n ExpQ
e (Name
t,[(Name, ExpQ)]
nrs) = (Name
t,(Name
n,ExpQ
e)forall a. a -> [a] -> [a]
:[(Name, ExpQ)]
nrs)
deriveEnumerable' :: ConstructorDeriv -> Q [Dec]
deriveEnumerable' :: ConstructorDeriv -> Q [Dec]
deriveEnumerable' (Name
n,[(Name, ExpQ)]
cse) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name -> [[(Name, [Type])] -> Q Dec] -> Name -> Q Dec
instanceFor ''Enumerable [[(Name, [Type])] -> Q Dec
enumDef] Name
n
where
enumDef :: [(Name,[Type])] -> Q Dec
enumDef :: [(Name, [Type])] -> Q Dec
enumDef [(Name, [Type])]
cons = do
Q ()
sanityCheck
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Dec
mk_freqs_binding [|datatype $ex |]
where
ex :: ExpQ
ex = forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Name, [a]) -> ExpQ
cone [(Name, [Type])]
cons
cone :: (Name, [a]) -> ExpQ
cone xs :: (Name, [a])
xs@(Name
n,[a]
_) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {m :: * -> *} {a}. Quote m => (Name, [a]) -> m Exp
cone' (Name, [a])
xs) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, ExpQ)]
cse
cone' :: (Name, [a]) -> m Exp
cone' (Name
n,[]) = [|c0 $(conE n)|]
cone' (Name
n,a
_:[a]
vs) =
[|c1 $(foldr appE (conE n) (map (const [|uncurry|] ) vs) )|]
mk_freqs_binding :: Exp -> Dec
mk_freqs_binding :: Exp -> Dec
mk_freqs_binding Exp
e = Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP 'enumerate ) (Exp -> Body
NormalB Exp
e) []
sanityCheck :: Q ()
sanityCheck = case forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, [Type])]
cons) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, ExpQ)]
cse) of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Name]
xs -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid constructors for "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Name
nforall a. [a] -> [a] -> [a]
++[Char]
": "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show [Name]
xs