packages feed

representable-tries 0.3 → 0.3.1

raw patch · 7 files changed

+355/−29 lines, 7 filesdep +bifunctorsdep +containersdep +streamsdep −eq

Dependencies added: bifunctors, containers, streams

Dependencies removed: eq

Files

Control/Monad/Reader/Trie.hs view
@@ -36,7 +36,7 @@  type instance Key (ReaderTrieT a m) = (a, Key m) -newtype ReaderTrieT a m b = ReaderTrieT { runReaderTrieT :: Trie a (m b) } +newtype ReaderTrieT a m b = ReaderTrieT { runReaderTrieT :: a :->: m b }   instance (HasTrie a, Functor m) => Functor (ReaderTrieT a m) where   fmap f = ReaderTrieT . fmap (fmap f) . runReaderTrieT@@ -57,7 +57,7 @@  instance (HasTrie a, Monad m) => MonadReader a (ReaderTrieT a m) where    ask = ReaderTrieT (trie return)-  local f (ReaderTrieT fm) = ReaderTrieT (tabulate (index fm . coerceKey . f . uncoerceKey))+  local f (ReaderTrieT fm) = ReaderTrieT (tabulate (index fm . f))  instance HasTrie a => MonadTrans (ReaderTrieT a) where   lift = ReaderTrieT . pure @@ -66,13 +66,13 @@   distribute = ReaderTrieT . fmap distribute . collect runReaderTrieT  instance (HasTrie a, Keyed m) => Keyed (ReaderTrieT a m) where-  mapWithKey f = ReaderTrieT . mapWithKey (\k -> mapWithKey (f . (,) (uncoerceKey k))) . runReaderTrieT+  mapWithKey f = ReaderTrieT . mapWithKey (\k -> mapWithKey (f . (,) k)) . runReaderTrieT  instance (HasTrie a, Indexable m) => Indexable (ReaderTrieT a m) where   index = uncurry . fmap index . untrie . runReaderTrieT -instance (HasTrie a, Lookup (Trie a), Lookup m) => Lookup (ReaderTrieT a m) where-  lookup (k,k') (ReaderTrieT fm) = lookup (coerceKey k) fm >>= lookup k'+instance (HasTrie a, Lookup ((:->:) a), Lookup m) => Lookup (ReaderTrieT a m) where+  lookup (k,k') (ReaderTrieT fm) = lookup k fm >>= lookup k'  instance (HasTrie a, Representable m) => Representable (ReaderTrieT a m) where   tabulate = ReaderTrieT . trie . fmap tabulate . curry@@ -84,10 +84,10 @@   foldMap1 f = foldMap1 (foldMap1 f) . runReaderTrieT  instance (HasTrie a, FoldableWithKey m) => FoldableWithKey (ReaderTrieT a m) where-  foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) (uncoerceKey k))) . runReaderTrieT+  foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) k)) . runReaderTrieT  instance (HasTrie a, FoldableWithKey1 m) => FoldableWithKey1 (ReaderTrieT a m) where-  foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) (uncoerceKey k))) . runReaderTrieT +  foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . runReaderTrieT   instance (HasTrie a, Traversable m) => Traversable (ReaderTrieT a m) where   traverse f = fmap ReaderTrieT . traverse (traverse f) . runReaderTrieT@@ -96,10 +96,10 @@   traverse1 f = fmap ReaderTrieT . traverse1 (traverse1 f) . runReaderTrieT  instance (HasTrie a, TraversableWithKey m) => TraversableWithKey (ReaderTrieT a m) where-  traverseWithKey f = fmap ReaderTrieT . traverseWithKey (\k -> traverseWithKey (f . (,) (uncoerceKey k))) . runReaderTrieT+  traverseWithKey f = fmap ReaderTrieT . traverseWithKey (\k -> traverseWithKey (f . (,) k)) . runReaderTrieT  instance (HasTrie a, TraversableWithKey1 m) => TraversableWithKey1 (ReaderTrieT a m) where-  traverseWithKey1 f = fmap ReaderTrieT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) (uncoerceKey k))) . runReaderTrieT+  traverseWithKey1 f = fmap ReaderTrieT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . runReaderTrieT  instance (HasTrie a, Representable m, Semigroup a, Semigroup (Key m)) => Extend (ReaderTrieT a m) where   extend = extendRep
Data/Functor/Representable/Trie.hs view
@@ -32,19 +32,16 @@ import Control.Monad.Representable import Data.Bits import Data.Distributive-import Data.Eq.Type import Data.Foldable import Data.Function (on) import Data.Functor.Adjunction import Data.Functor.Bind import Data.Functor.Identity-import Data.Functor.Product import Data.Functor.Representable import Data.Functor.Representable.Trie.Bool import Data.Functor.Representable.Trie.Either import Data.Functor.Representable.Trie.List import Data.Key-import Data.Key import Data.Monoid as Monoid import Data.Semigroup.Foldable import Data.Semigroup.Traversable@@ -63,6 +60,10 @@   -- projectKey . embedKey = id   embedKey   :: a -> Key (BaseTrie a)   projectKey :: Key (BaseTrie a) -> a+{-+  validKey   :: Key (BaseTrie a) -> Bool+  validKey _ = True+-}  data a :->: b where   Trie :: HasTrie a => BaseTrie a b -> a :->: b@@ -185,7 +186,7 @@   compare = compare `on` toList  instance (Show a, Show b) => Show (a :->: b) where -  showsPrec d t = showsPrec d (toKeyedList t)+  showsPrec d = showsPrec d . toKeyedList  instance Apply ((:->:) a) where   Trie f <.> Trie g = Trie (f <.> g)@@ -294,7 +295,7 @@   type BaseTrie (IntMap v) = ListTrie (BaseTrie (Int, v))   embedKey = foldrWithKey (\k v t -> embedKey (k,v) : t) []   projectKey = IntMap.fromDistinctAscList . map projectKey-  +    -- | Extract bits in little-endian order bits :: Bits t => t -> [Bool]@@ -320,15 +321,17 @@ bitsZ :: (Ord n, Bits n) => n -> (Bool,[Bool]) bitsZ = (>= 0) &&& (bits . abs) +-- TODO: fix the show instance of this instance HasTrie Int where   type BaseTrie Int = BaseTrie (Bool, [Bool])   embedKey = embedKey . bitsZ    projectKey = unbitsZ . projectKey +-- TODO: fix tree to 21 bit depth instance HasTrie Char where-  type BaseTrie Char = BaseTrie Int-  embedKey = embedKey . fromEnum-  projectKey = toEnum . projectKey+  type BaseTrie Char = BaseTrie [Bool]+  embedKey = bits . fromEnum+  projectKey = toEnum . unbits  instance (HasTrie a, HasTrie b, HasTrie c) => HasTrie (a,b,c) where   type BaseTrie (a,b,c) = BaseTrie (a,(b,c))
+ Data/Functor/Representable/Trie/Either.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE TypeFamilies #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Representable.Trie.Bool+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- +----------------------------------------------------------------------++module Data.Functor.Representable.Trie.Either ( +    EitherTrie (..) +  , left+  , right+  ) where++import Control.Applicative+import Data.Distributive+import Data.Functor.Representable+import Data.Functor.Bind+import Data.Foldable+import Data.Monoid+import Data.Traversable+import Data.Traversable.Fair+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Key+import Prelude hiding (lookup)++-- the product functor would be the trie of an either, but we fair traversal+data EitherTrie f g a = EitherTrie (f a) (g a)++type instance Key (EitherTrie f g) = Either (Key f) (Key g)++left :: EitherTrie f g a -> f a+left (EitherTrie f _) = f++right :: EitherTrie f g a -> g a +right (EitherTrie _ g) = g++instance (Apply f, Apply g, Semigroup s) => Semigroup (EitherTrie f g s) where+  EitherTrie a b <> EitherTrie c d = EitherTrie ((<>) <$> a <.> c) ((<>) <$> b <.> d)++instance (Applicative f, Applicative g, Monoid a) => Monoid (EitherTrie f g a) where+  mempty = EitherTrie (pure mempty) (pure mempty)+  EitherTrie a b `mappend` EitherTrie c d = EitherTrie (mappend <$> a <*> c) (mappend <$> b <*> d)+  +instance (Functor f, Functor g) => Functor (EitherTrie f g) where+  fmap f (EitherTrie fs gs) = EitherTrie (fmap f fs) (fmap f gs)+  b <$ EitherTrie fs gs = EitherTrie (b <$ fs) (b <$ gs)++instance (Apply f, Apply g) => Apply (EitherTrie f g) where+  EitherTrie ff fg <.> EitherTrie af ag = EitherTrie (ff <.> af) (fg <.> ag)+  a <. _ = a+  _ .> b = b++instance (Applicative f, Applicative g) => Applicative (EitherTrie f g) where+  pure a = EitherTrie (pure a) (pure a)+  EitherTrie ff fg <*> EitherTrie af ag = EitherTrie (ff <*> af) (fg <*> ag)+  a <* _ = a+  _ *> b = b++-- the direct implementation in terms of Bind is inefficient, using bindRep instead+instance (Representable f, Representable g) => Bind (EitherTrie f g) where+  (>>-) = bindRep++instance (Representable f, Representable g) => Monad (EitherTrie f g) where+  return = pure+  (>>=) = bindRep+  _ >> a = a++instance (Keyed f, Keyed g) => Keyed (EitherTrie f g) where+  mapWithKey f (EitherTrie fs gs) = EitherTrie (mapWithKey (f . Left) fs) (mapWithKey (f . Right) gs)++instance (Foldable f, Foldable g) => Foldable (EitherTrie f g) where+  foldMap f (EitherTrie fs gs) = foldMapBoth f fs gs++instance (Foldable1 f, Foldable1 g) => Foldable1 (EitherTrie f g) where+  foldMap1 f (EitherTrie fs gs) = foldMapBoth1 f fs gs++instance (Traversable f, Traversable g) => Traversable (EitherTrie f g) where+  traverse f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseBoth f fs gs++instance (Traversable1 f, Traversable1 g) => Traversable1 (EitherTrie f g) where+  traverse1 f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseBoth1 f fs gs++instance (FoldableWithKey f, FoldableWithKey g) => FoldableWithKey (EitherTrie f g) where+  foldMapWithKey f (EitherTrie fs gs) = foldMapWithKeyBoth (f . Left) (f . Right) fs gs++instance (FoldableWithKey1 f, FoldableWithKey1 g) => FoldableWithKey1 (EitherTrie f g) where+  foldMapWithKey1 f (EitherTrie fs gs) = foldMapWithKeyBoth1 (f . Left) (f . Right) fs gs++instance (TraversableWithKey f, TraversableWithKey g) => TraversableWithKey (EitherTrie f g) where+  traverseWithKey f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseWithKeyBoth (f . Left) (f . Right) fs gs++instance (TraversableWithKey1 f, TraversableWithKey1 g) => TraversableWithKey1 (EitherTrie f g) where+  traverseWithKey1 f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseWithKeyBoth1 (f . Left) (f . Right) fs gs++instance (Representable f, Representable g) => Distributive (EitherTrie f g) where+  distribute = distributeRep++instance (Indexable f, Indexable g) => Indexable (EitherTrie f g) where+  index (EitherTrie fs _) (Left  i) = index fs i+  index (EitherTrie _ gs) (Right j) = index gs j++instance (Adjustable f, Adjustable g) => Adjustable (EitherTrie f g) where+  adjust f (Left i) (EitherTrie fs gs)  = EitherTrie (adjust f i fs) gs+  adjust f (Right j) (EitherTrie fs gs) = EitherTrie fs (adjust f j gs)++instance (Lookup f, Lookup g) => Lookup (EitherTrie f g) where+  lookup (Left i) (EitherTrie fs _)  = lookup i fs+  lookup (Right j) (EitherTrie _ gs) = lookup j gs++instance (Representable f, Representable g) => Representable (EitherTrie f g) where+  tabulate f = EitherTrie (tabulate (f . Left)) (tabulate (f . Right))
Data/Functor/Representable/Trie/List.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies #-} ---------------------------------------------------------------------- -- |--- Module      :  Data.Functor.Representable.Trie.Bool+-- Module      :  Data.Functor.Representable.Trie.List -- Copyright   :  (c) Edward Kmett 2011 -- License     :  BSD3 --
Data/Traversable/Fair.hs view
@@ -13,17 +13,11 @@ import Control.Arrow import Data.Key import Data.Functor.Apply-import Data.Function (on) import Data.Monoid import Data.Stream.NonEmpty as NonEmpty hiding (toList)-import Data.Foldable --- placeholder instances-instance Foldable1 NonEmpty-instance Traversable1 NonEmpty- refill :: Traversable t => t a -> [b] -> t b-refill t l = snd (mapAccumL (\(x:xs) _ -> (xs, x)) l t)+refill t l = snd (mapAccumL (\xs _ -> (Prelude.tail xs, Prelude.head xs)) l t)  toNonEmptyList :: Foldable1 f => f a -> NonEmpty a toNonEmptyList = NonEmpty.fromList . toList@@ -45,7 +39,7 @@   go [] []         = pure ([],[])   go xs []         = flip (,) [] <$> traverse f xs   go [] ys         = (,) [] <$> traverse f ys-  go (x:xs) (y:ys) = (\x y (xs,ys) -> (x:xs,y:ys)) <$> f x <*> f y <*> go xs ys+  go (x:xs) (y:ys) = (\x' y' (xs',ys') -> (x':xs',y':ys')) <$> f x <*> f y <*> go xs ys  -- | fold both containers, interleaving results for fairness foldMapBoth1 :: (Foldable1 f, Foldable1 g, Semigroup m) => (a -> m) -> f a -> g a -> m@@ -95,7 +89,7 @@   go [] []         = pure ([],[])   go xs []         = flip (,) [] <$> traverse f' xs   go [] ys         = (,) [] <$> traverse g' ys-  go (x:xs) (y:ys) = (\x y (xs,ys) -> (x:xs,y:ys)) <$> f' x <*> g' y <*> go xs ys+  go (x:xs) (y:ys) = (\x' y' (xs',ys') -> (x':xs',y':ys')) <$> f' x <*> g' y <*> go xs ys  -- | fold both containers, interleaving results for fairness foldMapWithKeyBoth1
+ Numeric/Nat/Zeroless.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE TypeFamilies, Rank2Types, TypeOperators, GADTs, EmptyDataDecls, FlexibleInstances, FlexibleContexts, UndecidableInstances  #-}+----------------------------------------------------------------------+-- |+-- Module      :  Numeric.Nat.Zeroless+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- +-- Zeroless numbers encoded in zeroless binary numbers+----------------------------------------------------------------------++module Numeric.Nat.Zeroless+  ( D0(..), D1(..), D2(..), (:+:), (:*:), Zeroless(..)+  , Succ, Pred+  , N1, N8, N16, N32, N64+  , Nat(..), nat +  , Fin(..)+  , Reverse+  ) where++import Data.Function (on)+import Prelude hiding (lookup)++infixl 7 :*:+infixl 6 :+: ++-- * Type-level naturals using zeroless binary numbers++data D0 = D0 -- ^ 0 +data D1 n = D1 n -- ^ 2n + 1+data D2 n = D2 n -- ^ 2n + 2++-- * useful numbers+type N1 = D1 D0+type N8  = D2 (D1 (D1 D0))+type N16 = D2 (D1 (D1 (D1 D0)))+type N32 = D2 (D1 (D1 (D1 (D1 D0))))+type N64 = D2 (D1 (D1 (D1 (D1 (D1 D0)))))++-- * Successor +type family Succ n+type instance Succ D0 = D1 D0+type instance Succ (D1 n) = D2 n+type instance Succ (D2 n) = D1 (Succ n)++type family Pred n+type instance Pred (D1 D0) = D0+type instance Pred (D1 (D1 n)) = D2 (Pred (D1 n))+type instance Pred (D1 (D2 n)) = D2 (D1 n)+type instance Pred (D2 n) = D1 n++-- * Carry flags+data C0+data C1+data C2++-- * Add with carry+type family Add c n m+type instance Add C0 D0 n = n+type instance Add C1 D0 D0 = D1 D0+type instance Add C2 D0 D0 = D2 D0+type instance Add C1 D0 (D1 n) = D2 n+type instance Add C1 D0 (D2 n) = D1 (Add C1 D0 n) +type instance Add C2 D0 (D1 n) = D1 (Add C1 D0 n)+type instance Add C2 D0 (D2 n) = D2 (Add C1 D0 n)+type instance Add C0 (D1 n) D0 = D1 n+type instance Add C1 (D1 n) D0 = D2 n+type instance Add C2 (D1 n) D0 = D1 (Add C1 D0 n)+type instance Add C0 (D1 n) (D1 m) = D2 (Add C0 n m)+type instance Add C1 (D1 n) (D1 m) = D1 (Add C1 n m)+type instance Add C2 (D1 n) (D1 m) = D2 (Add C1 n m)+type instance Add C0 (D1 n) (D2 m) = D1 (Add C1 n m)+type instance Add C1 (D1 n) (D2 m) = D2 (Add C1 n m)+type instance Add C2 (D1 n) (D2 m) = D1 (Add C2 n m)+type instance Add C0 (D2 n) D0 = D2 n+type instance Add C1 (D2 n) D0 = D1 (Add C1 D0 n)+type instance Add C2 (D2 n) D0 = D2 (Add C1 D0 n)+type instance Add C0 (D2 n) (D1 m) = D1 (Add C1 n m)+type instance Add C1 (D2 n) (D1 m) = D2 (Add C1 n m)+type instance Add C2 (D2 n) (D1 m) = D1 (Add C2 n m)+type instance Add C0 (D2 n) (D2 m) = D2 (Add C1 n m)+type instance Add C1 (D2 n) (D2 m) = D1 (Add C2 n m)+type instance Add C2 (D2 n) (D2 m) = D2 (Add C2 n m)++-- * Adder+type n :+: m = Add C0 n m++-- * Multiplier+type family n :*: m+type instance D0 :*: m = D0+type instance D1 n :*: m = (n :*: m) :+: (n :*: m) :+: m+type instance D2 n :*: m = (n :*: m) :+: (n :*: m) :+: m :+: m++-- * Digit Counter+type family Digits n+type instance Digits D0 = D0+type instance Digits (D1 n) = Succ (Digits n)+type instance Digits (D2 n) = Succ (Digits n)++type family Reverse' n m+type instance Reverse' m D0     = m +type instance Reverse' m (D1 n) = Reverse' (D1 m) n +type instance Reverse' m (D2 n) = Reverse' (D2 m) n++-- * bitwise reversal+type Reverse n = Reverse' D0 n++{-+data Z = Z+newtype S n = S n+class Nat n where+  caseNat :: forall n. ((n ~ Z) => r) -> (forall x. (n ~ (S x), Nat x) => x -> r) -> r+-}++-- * Class of zeroless-binary numbers+class Zeroless n where+  ind :: f D0 +      -> (forall m. Zeroless m => f m -> f (D1 m)) +      -> (forall m. Zeroless m => f m -> f (D2 m))+      -> f n+  caseNat+    :: forall r. ((n ~ D0) => r) +    -> (forall x. (n ~ D1 x, Zeroless x) => x -> r)+    -> (forall x. (n ~ D2 x, Zeroless x) => x -> r)+    -> n -> r++instance Zeroless D0 where+  ind z _ _ = z +  caseNat z _ _ _ = z++instance Zeroless n => Zeroless (D1 n) where+  ind z f g = f (ind z f g)+  caseNat _ f _ (D1 x) = f x++instance Zeroless n => Zeroless (D2 n) where+  ind z f g = g (ind z f g)+  caseNat _ _ g (D2 x) = g x++class Zeroless n => Positive n+instance Zeroless n => Positive (D1 n)+instance Zeroless n => Positive (D2 n)++newtype Nat n = Nat { fromNat :: Int }++instance Zeroless n => Eq (Nat n) where+  _ == _ = True++instance Zeroless n => Ord (Nat n) where+  compare _ _ = EQ++instance Zeroless n => Show (Nat n) where+  showsPrec d (Nat n) = showsPrec d n++instance Zeroless n => Bounded (Nat n) where+  minBound = nat+  maxBound = nat++instance Zeroless n => Enum (Nat n) where+  fromEnum (Nat n) = n+  toEnum _ = nat++nat :: Zeroless n => Nat n +nat = ind (Nat 0) +          (Nat . (+1) . (*2) . fromNat) +          (Nat . (+2) . (*2) . fromNat)++-- * A finite number @m < n@+newtype Fin n = Fin { fromFin :: Int } ++instance Show (Fin n) where+  showsPrec d = showsPrec d . fromFin++instance Eq (Fin n) where+  (==) = (==) `on` fromFin++instance Ord (Fin n) where+  compare = compare `on` fromFin ++instance Positive n => Num (Fin n) where+  fromInteger = toEnum . fromInteger+  a + b = toEnum (fromFin a + fromFin b)+  a * b = toEnum (fromFin a * fromFin b)+  a - b = toEnum (fromFin a - fromFin b)+  abs a = a+  signum 0 = 0+  signum _ = 1++inFin :: (Int -> Int) -> Fin n -> Fin n+inFin f = Fin . f . fromFin++instance Positive n => Bounded (Fin n) where+  minBound = Fin 0+  maxBound = inFin (subtract 1) $ +             ind (Fin 0) +                 (Fin . ((+1) . (*2)) . fromFin)+                 (Fin . ((+2) . (*2)) . fromFin)++instance Positive n => Enum (Fin n) where+  fromEnum = fromFin+  toEnum n = r where+    r | n < 0 = error "Fin.toEnum: negative number"+      | Fin n <= b = Fin n `asTypeOf` b+      | otherwise = error "Fin.toEnum: index out of range"+    b = maxBound
representable-tries.cabal view
@@ -1,6 +1,6 @@ name:          representable-tries category:      Data Structures, Functors, Monads, Comonads-version:       0.3+version:       0.3.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -21,15 +21,17 @@   build-depends:      adjunctions >= 0.9 && < 0.10,     base >= 4 && < 4.4,+    bifunctors >= 0.1 && < 0.2,     comonad >= 1.0 && < 1.1,     comonad-transformers >= 1.5.2 && < 1.6,+    containers >= 0.4.0.0 && < 0.5,     distributive >= 0.1.1 && < 0.2,-    eq >= 0.2 && < 0.3,     keys >= 0.2.1 && < 0.3,     mtl >= 2.0.1.0 && < 2.1,     representable-functors >= 0.3 && < 0.4,     semigroups >= 0.3.4 && < 0.4,     semigroupoids >= 1.1.1 && < 1.2.0,+    streams >= 0.6 && < 0.7,     transformers >= 0.2.0 && < 0.3    exposed-modules:@@ -37,6 +39,9 @@     Data.Functor.Representable.Trie     Data.Functor.Representable.Trie.Bool     Data.Functor.Representable.Trie.List+    Data.Functor.Representable.Trie.Either     Data.Traversable.Fair+    Numeric.Nat.Zeroless +--     Data.Vector.Zeroless   ghc-options: -Wall