{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, ScopedTypeVariables, CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fenable-rewrite-rules #-}
module Data.MemoTrie
( HasTrie(..), (:->:)(..)
, domain, idTrie, (@.@)
, memo, memo2, memo3, mup
, inTrie, inTrie2, inTrie3
, trieGeneric, untrieGeneric, enumerateGeneric, Reg
, memoFix
) where
import Data.Bits
import Data.Word
import Data.Int
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Arrow (first,(&&&))
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import Data.Function (fix, on)
import GHC.Generics
import Control.Newtype.Generics
import Data.Void (Void)
infixr 0 :->:
class HasTrie a where
data (:->:) a :: * -> *
trie :: (a -> b) -> (a :->: b)
untrie :: (a :->: b) -> (a -> b)
enumerate :: (a :->: b) -> [(a,b)]
domain :: HasTrie a => [a]
domain :: forall a. HasTrie a => [a]
domain = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (forall a b. a -> b -> a
const forall {a}. a
oops)))
where
oops :: a
oops = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.MemoTrie.domain: range element evaluated."
instance (HasTrie a, Eq b) => Eq (a :->: b) where
== :: (a :->: b) -> (a :->: b) -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate)
instance (HasTrie a, Show a, Show b) => Show (a :->: b) where
show :: (a :->: b) -> [Char]
show a :->: b
t = [Char]
"Trie: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate a :->: b
t)
memo :: HasTrie t => (t -> a) -> (t -> a)
memo :: forall t a. HasTrie t => (t -> a) -> t -> a
memo = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. HasTrie a => (a -> b) -> a :->: b
trie
memo2 :: (HasTrie s,HasTrie t) => (s -> t -> a) -> (s -> t -> a)
memo3 :: (HasTrie r,HasTrie s,HasTrie t) => (r -> s -> t -> a) -> (r -> s -> t -> a)
mup :: HasTrie t => (b -> c) -> (t -> b) -> (t -> c)
mup :: forall t b c. HasTrie t => (b -> c) -> (t -> b) -> t -> c
mup b -> c
mem t -> b
f = forall t a. HasTrie t => (t -> a) -> t -> a
memo (b -> c
mem forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> b
f)
memo2 :: forall s t a.
(HasTrie s, HasTrie t) =>
(s -> t -> a) -> s -> t -> a
memo2 = forall t b c. HasTrie t => (b -> c) -> (t -> b) -> t -> c
mup forall t a. HasTrie t => (t -> a) -> t -> a
memo
memo3 :: forall r s t a.
(HasTrie r, HasTrie s, HasTrie t) =>
(r -> s -> t -> a) -> r -> s -> t -> a
memo3 = forall t b c. HasTrie t => (b -> c) -> (t -> b) -> t -> c
mup forall s t a.
(HasTrie s, HasTrie t) =>
(s -> t -> a) -> s -> t -> a
memo2
memoFix :: HasTrie a => ((a -> b) -> (a -> b)) -> (a -> b)
memoFix :: forall a b. HasTrie a => ((a -> b) -> a -> b) -> a -> b
memoFix (a -> b) -> a -> b
h = forall a. (a -> a) -> a
fix (forall t a. HasTrie t => (t -> a) -> t -> a
memo forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> a -> b
h)
#if 0
memoFix h = fix (\ f' -> memo (h f'))
memoFix h = f'
where f' = memo (h f')
memoFix h = f'
where
f' = memo f
f = h f'
#endif
#if 0
fibF :: (Integer -> Integer) -> (Integer -> Integer)
fibF _ 0 = 1
fibF _ 1 = 1
fibF f n = f (n-1) + f (n-2)
fib :: Integer -> Integer
fib = fix fibF
fib' :: Integer -> Integer
fib' = memoFix fibF
#endif
inTrie :: (HasTrie a, HasTrie c) =>
((a -> b) -> (c -> d))
-> ((a :->: b) -> (c :->: d))
inTrie :: forall a c b d.
(HasTrie a, HasTrie c) =>
((a -> b) -> c -> d) -> (a :->: b) -> c :->: d
inTrie = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie forall a' a b b'. (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'
~> forall a b. HasTrie a => (a -> b) -> a :->: b
trie
inTrie2 :: (HasTrie a, HasTrie c, HasTrie e) =>
((a -> b) -> (c -> d) -> (e -> f))
-> ((a :->: b) -> (c :->: d) -> (e :->: f))
inTrie2 :: forall a c e b d f.
(HasTrie a, HasTrie c, HasTrie e) =>
((a -> b) -> (c -> d) -> e -> f)
-> (a :->: b) -> (c :->: d) -> e :->: f
inTrie2 = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie forall a' a b b'. (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'
~> forall a c b d.
(HasTrie a, HasTrie c) =>
((a -> b) -> c -> d) -> (a :->: b) -> c :->: d
inTrie
inTrie3 :: (HasTrie a, HasTrie c, HasTrie e, HasTrie g) =>
((a -> b) -> (c -> d) -> (e -> f) -> (g -> h))
-> ((a :->: b) -> (c :->: d) -> (e :->: f) -> (g :->: h))
inTrie3 :: forall a c e g b d f h.
(HasTrie a, HasTrie c, HasTrie e, HasTrie g) =>
((a -> b) -> (c -> d) -> (e -> f) -> g -> h)
-> (a :->: b) -> (c :->: d) -> (e :->: f) -> g :->: h
inTrie3 = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie forall a' a b b'. (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'
~> forall a c e b d f.
(HasTrie a, HasTrie c, HasTrie e) =>
((a -> b) -> (c -> d) -> e -> f)
-> (a :->: b) -> (c :->: d) -> e :->: f
inTrie2
instance HasTrie Void where
data Void :->: a = VoidTrie
trie :: forall b. (Void -> b) -> Void :->: b
trie Void -> b
_ = forall a. Void :->: a
VoidTrie
untrie :: forall b. (Void :->: b) -> Void -> b
untrie Void :->: b
R::->:Voida b
VoidTrie = \ Void
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"untrie VoidTrie"
enumerate :: forall b. (Void :->: b) -> [(Void, b)]
enumerate Void :->: b
R::->:Voida b
VoidTrie = []
instance Newtype (Void :->: a) where
type O (Void :->: a) = ()
pack :: O (Void :->: a) -> Void :->: a
pack () = forall a. Void :->: a
VoidTrie
unpack :: (Void :->: a) -> O (Void :->: a)
unpack Void :->: a
R::->:Voida a
VoidTrie = ()
instance HasTrie () where
newtype () :->: a = UnitTrie a
trie :: forall b. (() -> b) -> () :->: b
trie () -> b
f = forall a. a -> () :->: a
UnitTrie (() -> b
f ())
untrie :: forall b. (() :->: b) -> () -> b
untrie (UnitTrie b
a) = \ () -> b
a
enumerate :: forall b. (() :->: b) -> [((), b)]
enumerate (UnitTrie b
a) = [((),b
a)]
instance Newtype (() :->: a) where
type O (() :->: a) = a
pack :: O (() :->: a) -> () :->: a
pack O (() :->: a)
a = forall a. a -> () :->: a
UnitTrie O (() :->: a)
a
unpack :: (() :->: a) -> O (() :->: a)
unpack (UnitTrie a
a) = a
a
instance HasTrie Bool where
data Bool :->: x = BoolTrie x x
trie :: forall b. (Bool -> b) -> Bool :->: b
trie Bool -> b
f = forall x. x -> x -> Bool :->: x
BoolTrie (Bool -> b
f Bool
False) (Bool -> b
f Bool
True)
untrie :: forall b. (Bool :->: b) -> Bool -> b
untrie (BoolTrie b
f b
t) = forall x. x -> x -> Bool -> x
if' b
f b
t
enumerate :: forall b. (Bool :->: b) -> [(Bool, b)]
enumerate (BoolTrie b
f b
t) = [(Bool
False,b
f),(Bool
True,b
t)]
instance Newtype (Bool :->: a) where
type O (Bool :->: a) = (a,a)
pack :: O (Bool :->: a) -> Bool :->: a
pack (a
a,a
a') = forall x. x -> x -> Bool :->: x
BoolTrie a
a a
a'
unpack :: (Bool :->: a) -> O (Bool :->: a)
unpack (BoolTrie a
a a
a') = (a
a,a
a')
if' :: x -> x -> Bool -> x
if' :: forall x. x -> x -> Bool -> x
if' x
t x
_ Bool
False = x
t
if' x
_ x
e Bool
True = x
e
instance HasTrie a => HasTrie (Maybe a) where
data (:->:) (Maybe a) b = MaybeTrie b (a :->: b)
trie :: forall b. (Maybe a -> b) -> Maybe a :->: b
trie Maybe a -> b
f = forall a b. b -> (a :->: b) -> Maybe a :->: b
MaybeTrie (Maybe a -> b
f forall a. Maybe a
Nothing) (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (Maybe a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just))
untrie :: forall b. (Maybe a :->: b) -> Maybe a -> b
untrie (MaybeTrie b
nothing_val a :->: b
a_trie) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
nothing_val (forall a b. HasTrie a => (a :->: b) -> a -> b
untrie a :->: b
a_trie)
enumerate :: forall b. (Maybe a :->: b) -> [(Maybe a, b)]
enumerate (MaybeTrie b
nothing_val a :->: b
a_trie) = (forall a. Maybe a
Nothing, b
nothing_val) forall a. a -> [a] -> [a]
: forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall a. a -> Maybe a
Just a :->: b
a_trie
instance Newtype (Maybe a :->: x) where
type O (Maybe a :->: x) = (x, a :->: x)
pack :: O (Maybe a :->: x) -> Maybe a :->: x
pack (x
a,a :->: x
f) = forall a b. b -> (a :->: b) -> Maybe a :->: b
MaybeTrie x
a a :->: x
f
unpack :: (Maybe a :->: x) -> O (Maybe a :->: x)
unpack (MaybeTrie x
a a :->: x
f) = (x
a,a :->: x
f)
instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where
data (Either a b) :->: x = EitherTrie (a :->: x) (b :->: x)
trie :: forall b. (Either a b -> b) -> Either a b :->: b
trie Either a b -> b
f = forall a b x. (a :->: x) -> (b :->: x) -> Either a b :->: x
EitherTrie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (Either a b -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)) (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (Either a b -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right))
untrie :: forall b. (Either a b :->: b) -> Either a b -> b
untrie (EitherTrie a :->: b
s b :->: b
t) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. HasTrie a => (a :->: b) -> a -> b
untrie a :->: b
s) (forall a b. HasTrie a => (a :->: b) -> a -> b
untrie b :->: b
t)
enumerate :: forall b. (Either a b :->: b) -> [(Either a b, b)]
enumerate (EitherTrie a :->: b
s b :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall a b. a -> Either a b
Left a :->: b
s forall a. [a] -> [a] -> [a]
`weave` forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall a b. b -> Either a b
Right b :->: b
t
instance Newtype (Either a b :->: x) where
type O (Either a b :->: x) = (a :->: x, b :->: x)
pack :: O (Either a b :->: x) -> Either a b :->: x
pack (a :->: x
f,b :->: x
g) = forall a b x. (a :->: x) -> (b :->: x) -> Either a b :->: x
EitherTrie a :->: x
f b :->: x
g
unpack :: (Either a b :->: x) -> O (Either a b :->: x)
unpack (EitherTrie a :->: x
f b :->: x
g) = (a :->: x
f,b :->: x
g)
enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]
enum' :: forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' a -> a'
f = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first) a -> a'
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate
weave :: [a] -> [a] -> [a]
[] weave :: forall a. [a] -> [a] -> [a]
`weave` [a]
as = [a]
as
[a]
as `weave` [] = [a]
as
(a
a:[a]
as) `weave` [a]
bs = a
a forall a. a -> [a] -> [a]
: ([a]
bs forall a. [a] -> [a] -> [a]
`weave` [a]
as)
instance (HasTrie a, HasTrie b) => HasTrie (a,b) where
newtype (a,b) :->: x = PairTrie (a :->: (b :->: x))
trie :: forall b. ((a, b) -> b) -> (a, b) :->: b
trie (a, b) -> b
f = forall a b x. (a :->: (b :->: x)) -> (a, b) :->: x
PairTrie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> b
f))
untrie :: forall b. ((a, b) :->: b) -> (a, b) -> b
untrie (PairTrie a :->: (b :->: b)
t) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. HasTrie a => (a :->: b) -> a -> b
untrie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. HasTrie a => (a :->: b) -> a -> b
untrie a :->: (b :->: b)
t)
enumerate :: forall b. ((a, b) :->: b) -> [((a, b), b)]
enumerate (PairTrie a :->: (b :->: b)
tt) =
[ ((a
a,b
b),b
x) | (a
a,b :->: b
t) <- forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate a :->: (b :->: b)
tt , (b
b,b
x) <- forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate b :->: b
t ]
instance Newtype ((a,b) :->: x) where
type O ((a,b) :->: x) = a :->: b :->: x
pack :: O ((a, b) :->: x) -> (a, b) :->: x
pack O ((a, b) :->: x)
abx = forall a b x. (a :->: (b :->: x)) -> (a, b) :->: x
PairTrie O ((a, b) :->: x)
abx
unpack :: ((a, b) :->: x) -> O ((a, b) :->: x)
unpack (PairTrie a :->: (b :->: x)
abx) = a :->: (b :->: x)
abx
instance (HasTrie a, HasTrie b, HasTrie c) => HasTrie (a,b,c) where
newtype (a,b,c) :->: x = TripleTrie (((a,b),c) :->: x)
trie :: forall b. ((a, b, c) -> b) -> (a, b, c) :->: b
trie (a, b, c) -> b
f = forall a b c x. (((a, b), c) :->: x) -> (a, b, c) :->: x
TripleTrie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((a, b, c) -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. ((a, b), c) -> (a, b, c)
trip))
untrie :: forall b. ((a, b, c) :->: b) -> (a, b, c) -> b
untrie (TripleTrie ((a, b), c) :->: b
t) = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ((a, b), c) :->: b
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> ((a, b), c)
detrip
enumerate :: forall b. ((a, b, c) :->: b) -> [((a, b, c), b)]
enumerate (TripleTrie ((a, b), c) :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall a b c. ((a, b), c) -> (a, b, c)
trip ((a, b), c) :->: b
t
trip :: ((a,b),c) -> (a,b,c)
trip :: forall a b c. ((a, b), c) -> (a, b, c)
trip ((a
a,b
b),c
c) = (a
a,b
b,c
c)
detrip :: (a,b,c) -> ((a,b),c)
detrip :: forall a b c. (a, b, c) -> ((a, b), c)
detrip (a
a,b
b,c
c) = ((a
a,b
b),c
c)
instance HasTrie x => HasTrie [x] where
newtype [x] :->: a = ListTrie (Either () (x,[x]) :->: a)
trie :: forall b. ([x] -> b) -> [x] :->: b
trie [x] -> b
f = forall x a. (Either () (x, [x]) :->: a) -> [x] :->: a
ListTrie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie ([x] -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Either () (x, [x]) -> [x]
list))
untrie :: forall b. ([x] :->: b) -> [x] -> b
untrie (ListTrie Either () (x, [x]) :->: b
t) = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie Either () (x, [x]) :->: b
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. [x] -> Either () (x, [x])
delist
enumerate :: forall b. ([x] :->: b) -> [([x], b)]
enumerate (ListTrie Either () (x, [x]) :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall x. Either () (x, [x]) -> [x]
list Either () (x, [x]) :->: b
t
list :: Either () (x,[x]) -> [x]
list :: forall x. Either () (x, [x]) -> [x]
list = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:))
delist :: [x] -> Either () (x,[x])
delist :: forall x. [x] -> Either () (x, [x])
delist [] = forall a b. a -> Either a b
Left ()
delist (x
x:[x]
xs) = forall a b. b -> Either a b
Right (x
x,[x]
xs)
#define WordInstance(Type,TrieType)\
instance HasTrie Type where \
newtype Type :->: a = TrieType ([Bool] :->: a);\
trie f = TrieType (trie (f . unbits));\
untrie (TrieType t) = untrie t . bits;\
enumerate (TrieType t) = enum' unbits t
WordInstance(Word,WordTrie)
WordInstance(Word8,Word8Trie)
WordInstance(Word16,Word16Trie)
WordInstance(Word32,Word32Trie)
WordInstance(Word64,Word64Trie)
bits :: (Num t, Bits t) => t -> [Bool]
bits :: forall t. (Num t, Bits t) => t -> [Bool]
bits t
0 = []
bits t
x = forall a. Bits a => a -> Int -> Bool
testBit t
x Int
0 forall a. a -> [a] -> [a]
: forall t. (Num t, Bits t) => t -> [Bool]
bits (forall a. Bits a => a -> Int -> a
shiftR t
x Int
1)
unbit :: Num t => Bool -> t
unbit :: forall t. Num t => Bool -> t
unbit Bool
False = t
0
unbit Bool
True = t
1
unbits :: (Num t, Bits t) => [Bool] -> t
unbits :: forall t. (Num t, Bits t) => [Bool] -> t
unbits [] = t
0
unbits (Bool
x:[Bool]
xs) = forall t. Num t => Bool -> t
unbit Bool
x forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall t. (Num t, Bits t) => [Bool] -> t
unbits [Bool]
xs) Int
1
instance HasTrie Char where
newtype Char :->: a = CharTrie (Int :->: a)
untrie :: forall b. (Char :->: b) -> Char -> b
untrie (CharTrie Int :->: b
t) Char
n = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie Int :->: b
t (forall a. Enum a => a -> Int
fromEnum Char
n)
trie :: forall b. (Char -> b) -> Char :->: b
trie Char -> b
f = forall a. (Int :->: a) -> Char :->: a
CharTrie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (Char -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum))
enumerate :: forall b. (Char :->: b) -> [(Char, b)]
enumerate (CharTrie Int :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall a. Enum a => Int -> a
toEnum Int :->: b
t
#define IntInstance(IntType,WordType,TrieType) \
instance HasTrie IntType where \
newtype IntType :->: a = TrieType (WordType :->: a); \
untrie (TrieType t) n = untrie t (fromIntegral n); \
trie f = TrieType (trie (f . fromIntegral)); \
enumerate (TrieType t) = enum' fromIntegral t
IntInstance(Int,Word,IntTrie)
IntInstance(Int8,Word8,Int8Trie)
IntInstance(Int16,Word16,Int16Trie)
IntInstance(Int32,Word32,Int32Trie)
IntInstance(Int64,Word64,Int64Trie)
instance HasTrie Integer where
newtype Integer :->: a = IntegerTrie ((Bool,[Bool]) :->: a)
trie :: forall b. (Integer -> b) -> Integer :->: b
trie Integer -> b
f = forall a. ((Bool, [Bool]) :->: a) -> Integer :->: a
IntegerTrie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (Integer -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Num n, Bits n) => (Bool, [Bool]) -> n
unbitsZ))
untrie :: forall b. (Integer :->: b) -> Integer -> b
untrie (IntegerTrie (Bool, [Bool]) :->: b
t) = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie (Bool, [Bool]) :->: b
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Num n, Ord n, Bits n) => n -> (Bool, [Bool])
bitsZ
enumerate :: forall b. (Integer :->: b) -> [(Integer, b)]
enumerate (IntegerTrie (Bool, [Bool]) :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall n. (Num n, Bits n) => (Bool, [Bool]) -> n
unbitsZ (Bool, [Bool]) :->: b
t
unbitsZ :: (Num n, Bits n) => (Bool,[Bool]) -> n
unbitsZ :: forall n. (Num n, Bits n) => (Bool, [Bool]) -> n
unbitsZ (Bool
positive,[Bool]
bs) = n -> n
sig (forall t. (Num t, Bits t) => [Bool] -> t
unbits [Bool]
bs)
where
sig :: n -> n
sig | Bool
positive = forall a. a -> a
id
| Bool
otherwise = forall a. Num a => a -> a
negate
bitsZ :: (Num n, Ord n, Bits n) => n -> (Bool,[Bool])
bitsZ :: forall n. (Num n, Ord n, Bits n) => n -> (Bool, [Bool])
bitsZ = (forall a. Ord a => a -> a -> Bool
>= n
0) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall t. (Num t, Bits t) => t -> [Bool]
bits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs)
instance (HasTrie a, Monoid b) => Monoid (a :->: b) where
mempty :: a :->: b
mempty = forall a b. HasTrie a => (a -> b) -> a :->: b
trie forall a. Monoid a => a
mempty
#if !MIN_VERSION_base(4,11,0)
mappend = inTrie2 mappend
#else
instance (HasTrie a, Semigroup b) => Semigroup (a :->: b) where
<> :: (a :->: b) -> (a :->: b) -> a :->: b
(<>) = forall a c e b d f.
(HasTrie a, HasTrie c, HasTrie e) =>
((a -> b) -> (c -> d) -> e -> f)
-> (a :->: b) -> (c :->: d) -> e :->: f
inTrie2 forall a. Semigroup a => a -> a -> a
(<>)
#endif
instance HasTrie a => Functor ((:->:) a) where
fmap :: forall a b. (a -> b) -> (a :->: a) -> a :->: b
fmap a -> b
f = forall a c b d.
(HasTrie a, HasTrie c) =>
((a -> b) -> c -> d) -> (a :->: b) -> c :->: d
inTrie (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
instance HasTrie a => Applicative ((:->:) a) where
pure :: forall a. a -> a :->: a
pure a
b = forall a b. HasTrie a => (a -> b) -> a :->: b
trie (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b)
<*> :: forall a b. (a :->: (a -> b)) -> (a :->: a) -> a :->: b
(<*>) = forall a c e b d f.
(HasTrie a, HasTrie c, HasTrie e) =>
((a -> b) -> (c -> d) -> e -> f)
-> (a :->: b) -> (c :->: d) -> e :->: f
inTrie2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
instance HasTrie a => Monad ((:->:) a) where
return :: forall a. a -> a :->: a
return a
a = forall a b. HasTrie a => (a -> b) -> a :->: b
trie (forall (m :: * -> *) a. Monad m => a -> m a
return a
a)
a :->: a
u >>= :: forall a b. (a :->: a) -> (a -> a :->: b) -> a :->: b
>>= a -> a :->: b
k = forall a b. HasTrie a => (a -> b) -> a :->: b
trie (forall a b. HasTrie a => (a :->: b) -> a -> b
untrie a :->: a
u forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. HasTrie a => (a :->: b) -> a -> b
untrie forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a :->: b
k)
idTrie :: HasTrie a => a :->: a
idTrie :: forall a. HasTrie a => a :->: a
idTrie = forall a b. HasTrie a => (a -> b) -> a :->: b
trie forall a. a -> a
id
infixr 9 @.@
(@.@) :: (HasTrie a, HasTrie b) =>
(b :->: c) -> (a :->: b) -> (a :->: c)
@.@ :: forall a b c.
(HasTrie a, HasTrie b) =>
(b :->: c) -> (a :->: b) -> a :->: c
(@.@) = forall a c e b d f.
(HasTrie a, HasTrie c, HasTrie e) =>
((a -> b) -> (c -> d) -> e -> f)
-> (a :->: b) -> (c :->: d) -> e :->: f
inTrie2 forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
(~>) :: (a' -> a) -> (b -> b') -> ((a -> b) -> (a' -> b'))
a' -> a
g ~> :: forall a' a b b'. (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'
~> b -> b'
f = (b -> b'
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
g)
instance HasTrie (V1 x) where
data (V1 x :->: b) = V1Trie
trie :: forall b. (V1 x -> b) -> V1 x :->: b
trie V1 x -> b
_ = forall x b. V1 x :->: b
V1Trie
untrie :: forall b. (V1 x :->: b) -> V1 x -> b
untrie V1 x :->: b
R::->:V1b x b
V1Trie = \ V1 x
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"untrie V1Trie"
enumerate :: forall b. (V1 x :->: b) -> [(V1 x, b)]
enumerate V1 x :->: b
R::->:V1b x b
V1Trie = []
instance HasTrie (U1 x) where
newtype (U1 x :->: b) = U1Trie b
trie :: forall b. (U1 x -> b) -> U1 x :->: b
trie U1 x -> b
f = forall x b. b -> U1 x :->: b
U1Trie (U1 x -> b
f forall k (p :: k). U1 p
U1)
untrie :: forall b. (U1 x :->: b) -> U1 x -> b
untrie (U1Trie b
b) = \U1 x
U1 -> b
b
enumerate :: forall b. (U1 x :->: b) -> [(U1 x, b)]
enumerate (U1Trie b
b) = [(forall k (p :: k). U1 p
U1, b
b)]
instance (HasTrie (f x), HasTrie (g x)) => HasTrie ((f :+: g) x) where
newtype ((f :+: g) x :->: b) = EitherTrie1 (Either (f x) (g x) :->: b)
trie :: forall b. ((:+:) f g x -> b) -> (:+:) f g x :->: b
trie (:+:) f g x -> b
f = forall (f :: * -> *) (g :: * -> *) x b.
(Either (f x) (g x) :->: b) -> (:+:) f g x :->: b
EitherTrie1 (forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((:+:) f g x -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a (g :: * -> *).
Either (f a) (g a) -> (:+:) f g a
liftSum))
untrie :: forall b. ((:+:) f g x :->: b) -> (:+:) f g x -> b
untrie (EitherTrie1 Either (f x) (g x) :->: b
t) = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie Either (f x) (g x) :->: b
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) a.
(:+:) f g a -> Either (f a) (g a)
dropSum
enumerate :: forall b. ((:+:) f g x :->: b) -> [((:+:) f g x, b)]
enumerate (EitherTrie1 Either (f x) (g x) :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall (f :: * -> *) a (g :: * -> *).
Either (f a) (g a) -> (:+:) f g a
liftSum Either (f x) (g x) :->: b
t
instance (HasTrie (f x), HasTrie (g x)) => HasTrie ((f :*: g) x) where
newtype ((f :*: g) x :->: b) = PairTrie1 ((f x, g x) :->: b)
trie :: forall b. ((:*:) f g x -> b) -> (:*:) f g x :->: b
trie (:*:) f g x -> b
f = forall (f :: * -> *) (g :: * -> *) x b.
((f x, g x) :->: b) -> (:*:) f g x :->: b
PairTrie1 (forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((:*:) f g x -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a (g :: * -> *). (f a, g a) -> (:*:) f g a
liftProduct))
untrie :: forall b. ((:*:) f g x :->: b) -> (:*:) f g x -> b
untrie (PairTrie1 (f x, g x) :->: b
t) = forall a b. HasTrie a => (a :->: b) -> a -> b
untrie (f x, g x) :->: b
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> (f a, g a)
dropProduct
enumerate :: forall b. ((:*:) f g x :->: b) -> [((:*:) f g x, b)]
enumerate (PairTrie1 (f x, g x) :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall (f :: * -> *) a (g :: * -> *). (f a, g a) -> (:*:) f g a
liftProduct (f x, g x) :->: b
t
instance (HasTrie a) => HasTrie (K1 i a x) where
newtype (K1 i a x :->: b) = K1Trie (a :->: b)
trie :: forall b. (K1 i a x -> b) -> K1 i a x :->: b
trie K1 i a x -> b
f = forall i a x b. (a :->: b) -> K1 i a x :->: b
K1Trie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (K1 i a x -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1))
untrie :: forall b. (K1 i a x :->: b) -> K1 i a x -> b
untrie (K1Trie a :->: b
t) = \(K1 a
a) -> forall a b. HasTrie a => (a :->: b) -> a -> b
untrie a :->: b
t a
a
enumerate :: forall b. (K1 i a x :->: b) -> [(K1 i a x, b)]
enumerate (K1Trie a :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall k i c (p :: k). c -> K1 i c p
K1 a :->: b
t
instance (HasTrie (f x)) => HasTrie (M1 i t f x) where
newtype (M1 i t f x :->: b) = M1Trie (f x :->: b)
trie :: forall b. (M1 i t f x -> b) -> M1 i t f x :->: b
trie M1 i t f x -> b
f = forall i (t :: Meta) (f :: * -> *) x b.
(f x :->: b) -> M1 i t f x :->: b
M1Trie (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (M1 i t f x -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1))
untrie :: forall b. (M1 i t f x :->: b) -> M1 i t f x -> b
untrie (M1Trie f x :->: b
t) = \(M1 f x
a) -> forall a b. HasTrie a => (a :->: b) -> a -> b
untrie f x :->: b
t f x
a
enumerate :: forall b. (M1 i t f x :->: b) -> [(M1 i t f x, b)]
enumerate (M1Trie f x :->: b
t) = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f x :->: b
t
type Reg a = Rep a ()
trieGeneric :: (Generic a, HasTrie (Reg a))
=> ((Reg a :->: b) -> (a :->: b))
-> (a -> b)
-> (a :->: b)
trieGeneric :: forall a b.
(Generic a, HasTrie (Reg a)) =>
((Reg a :->: b) -> a :->: b) -> (a -> b) -> a :->: b
trieGeneric (Reg a :->: b) -> a :->: b
theConstructor a -> b
f = (Reg a :->: b) -> a :->: b
theConstructor (forall a b. HasTrie a => (a -> b) -> a :->: b
trie (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => Rep a x -> a
to))
{-# INLINEABLE trieGeneric #-}
untrieGeneric :: (Generic a, HasTrie (Reg a))
=> ((a :->: b) -> (Reg a :->: b))
-> (a :->: b)
-> (a -> b)
untrieGeneric :: forall a b.
(Generic a, HasTrie (Reg a)) =>
((a :->: b) -> Reg a :->: b) -> (a :->: b) -> a -> b
untrieGeneric (a :->: b) -> Reg a :->: b
theDestructor a :->: b
t = \a
a -> forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ((a :->: b) -> Reg a :->: b
theDestructor a :->: b
t) (forall a x. Generic a => a -> Rep a x
from a
a)
{-# INLINEABLE untrieGeneric #-}
enumerateGeneric :: (Generic a, HasTrie (Reg a))
=> ((a :->: b) -> (Reg a :->: b))
-> (a :->: b)
-> [(a, b)]
enumerateGeneric :: forall a b.
(Generic a, HasTrie (Reg a)) =>
((a :->: b) -> Reg a :->: b) -> (a :->: b) -> [(a, b)]
enumerateGeneric (a :->: b) -> Reg a :->: b
theDestructor a :->: b
t = forall a a' b. HasTrie a => (a -> a') -> (a :->: b) -> [(a', b)]
enum' forall a x. Generic a => Rep a x -> a
to ((a :->: b) -> Reg a :->: b
theDestructor a :->: b
t)
{-# INLINEABLE enumerateGeneric #-}
dropProduct :: (f :*: g) a -> (f a, g a)
dropProduct :: forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> (f a, g a)
dropProduct (f a
a :*: g a
b) = (f a
a, g a
b)
{-# INLINEABLE dropProduct #-}
liftProduct :: (f a, g a) -> (f :*: g) a
liftProduct :: forall (f :: * -> *) a (g :: * -> *). (f a, g a) -> (:*:) f g a
liftProduct (f a
a, g a
b) = f a
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
b
{-# INLINEABLE liftProduct #-}
dropSum :: (f :+: g) a -> Either (f a) (g a)
dropSum :: forall (f :: * -> *) (g :: * -> *) a.
(:+:) f g a -> Either (f a) (g a)
dropSum (:+:) f g a
s = case (:+:) f g a
s of
L1 f a
x -> forall a b. a -> Either a b
Left f a
x
R1 g a
x -> forall a b. b -> Either a b
Right g a
x
{-# INLINEABLE dropSum #-}
liftSum :: Either (f a) (g a) -> (f :+: g) a
liftSum :: forall (f :: * -> *) a (g :: * -> *).
Either (f a) (g a) -> (:+:) f g a
liftSum = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1
{-# INLINEABLE liftSum #-}