MemoTrie 0.4.3 → 0.4.5

raw patch · 2 files changed

+86/−17 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• MemoTrie.cabal +1/−1
• src/Data/MemoTrie.hs +85/−16

@@ -1,5 +1,5 @@ Name:                MemoTrie-Version:             0.4.3+Version:             0.4.5 Cabal-Version:       >= 1.2 Synopsis:            Trie-based memo functions Category:            Data

@@ -17,7 +17,7 @@ ----------------------------------------------------------------------  module Data.MemoTrie-  ( HasTrie(..)+  ( HasTrie(..), domain, idTrie, (@.@)   , memo, memo2, memo3, mup   , inTrie, inTrie2, inTrie3   -- , untrieBits@@ -26,7 +26,9 @@ import Data.Bits import Data.Word import Control.Applicative+import Control.Arrow (first,(&&&)) import Data.Monoid+import Data.Function (on)  -- import Prelude hiding (id,(.)) -- import Control.Category@@ -40,7 +42,23 @@     trie   :: (a  ->  b) -> (a :->: b)     -- | Convert a trie to a function, i.e., access a field of the trie     untrie :: (a :->: b) -> (a  ->  b)+    -- | List the trie elements.  Order of keys (@:: a@) is always the same.+    enumerate :: (a :->: b) -> [(a,b)] +-- | Domain elements of a trie+domain :: HasTrie a => [a]+domain = map fst (enumerate (trie (const oops)))+ where+   oops = error "Data.MemoTrie.domain: range element evaluated."++-- Hm: domain :: [Bool] doesn't produce any output.++instance (HasTrie a, Eq b) => Eq (a :->: b) where+  (==) = (==) `on` (map snd . enumerate)++instance (HasTrie a, Show a, Show b) => Show (a :->: b) where+  show t = "Trie: " ++ show (enumerate t)+ {-# RULES "trie/untrie"   forall t. trie (untrie t) = t  #-}@@ -95,7 +113,8 @@ instance HasTrie () where     data () :->: a = UnitTrie a     trie f = UnitTrie (f ())-    untrie (UnitTrie a) = const a+    untrie (UnitTrie a) = \ () -> a+    enumerate (UnitTrie a) = [((),a)]  -- Proofs of inverse properties: @@ -104,17 +123,25 @@       == { trie def }     untrie (UnitTrie (f ()))       == { untrie def }-    const (f ())+    \ () -> (f ())       == { const-unit }     f         trie (untrie (UnitTrie a))       == { untrie def }-    trie (const a)+    trie (\ () -> a)       == { trie def }-    UnitTrie (const a ())-      == { const }+    UnitTrie ((\ () -> a) ())+      == { beta-reduction }     UnitTrie a++Oops -- the last step of the first direction is bogus when f is non-strict.+Can be fixed by using @const a@ in place of @\ () -> a@, but I can't do+the same for other types, like integers or sums.++All of these proofs have this same bug, unless we restrict ourselves to+memoizing hyper-strict functions.+ -}  @@ -122,12 +149,13 @@     data Bool :->: x = BoolTrie x x     trie f = BoolTrie (f False) (f True)     untrie (BoolTrie f t) = if' f t+    enumerate (BoolTrie f t) = [(False,f),(True,t)]  -- | Conditional with boolean last. -- Spec: @if' (f False) (f True) == f@ if' :: x -> x -> Bool -> x-if' f _ False = f-if' _ t True  = t+if' t _ False = t+if' _ e True  = e  {-     untrie (trie f)@@ -152,7 +180,16 @@     data (Either a b) :->: x = EitherTrie (a :->: x) (b :->: x)     trie f = EitherTrie (trie (f . Left)) (trie (f . Right))     untrie (EitherTrie s t) = either (untrie s) (untrie t)+    enumerate (EitherTrie s t) = enum' Left s `weave` enum' Right t +enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]+enum' f = (fmap.first) f . enumerate++weave :: [a] -> [a] -> [a]+[] `weave` as = as+as `weave` [] = as+(a:as) `weave` bs = a : (bs `weave` as)+ {-     untrie (trie f)        == { trie def }@@ -181,6 +218,8 @@     data (a,b) :->: x = PairTrie (a :->: (b :->: x))     trie f = PairTrie (trie (trie . curry f))     untrie (PairTrie t) = uncurry (untrie .  untrie t)+    enumerate (PairTrie tt) =+      [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ]  {-     untrie (trie f)@@ -212,6 +251,7 @@     data (a,b,c) :->: x = TripleTrie (((a,b),c) :->: x)     trie f = TripleTrie (trie (f . trip))     untrie (TripleTrie t) = untrie t . detrip+    enumerate (TripleTrie t) = enum' trip t  trip :: ((a,b),c) -> (a,b,c) trip ((a,b),c) = (a,b,c)@@ -224,6 +264,7 @@     data [x] :->: a = ListTrie (Either () (x,[x]) :->: a)     trie f = ListTrie (trie (f . list))     untrie (ListTrie t) = untrie t . delist+    enumerate (ListTrie t) = enum' list t  list :: Either () (x,[x]) -> [x] list = either (const []) (uncurry (:))@@ -237,7 +278,9 @@     data Word :->: a = WordTrie ([Bool] :->: a)     trie f = WordTrie (trie (f . unbits))     untrie (WordTrie t) = untrie t . bits+    enumerate (WordTrie t) = enum' unbits t + -- | Extract bits in little-endian order bits :: Bits t => t -> [Bool] bits 0 = []@@ -263,13 +306,28 @@     data Int :->: a = IntTrie (Word :->: a)     untrie (IntTrie t) n = untrie t (fromIntegral n)     trie f = IntTrie (trie (f . fromIntegral . toInteger))+    enumerate (IntTrie t) = enum' fromIntegral t  instance HasTrie Integer where-    data Integer :->: a = IntegerTrie (Word :->: a)-    untrie (IntegerTrie t) n = untrie t (fromIntegral n)-    trie f = IntegerTrie (trie (f . fromIntegral . toInteger))+    data Integer :->: a = IntegerTrie ((Bool,[Bool]) :->: a)+    trie f = IntegerTrie (trie (f . unbitsZ))+    untrie (IntegerTrie t) = untrie t . bitsZ+    enumerate (IntegerTrie t) = enum' unbitsZ t  +unbitsZ :: (Bool,[Bool]) -> Integer+unbitsZ (positive,bs) = sig (unbits bs)+ where+   sig | positive  = id+       | otherwise = negate++bitsZ :: Integer -> (Bool,[Bool])+bitsZ = (>= 0) &&& (bits . abs)++-- bitsZ n = (sign n, bits (abs n))+++ -- TODO: make these definitions more systematic.  @@ -359,9 +417,21 @@   return a = trie (return a)   u >>= k  = trie (untrie u >>= untrie . k) +-- | Identity trie+idTrie :: HasTrie a => a :->: a+idTrie = trie id++infixr 9 @.@+-- | Trie composition+(@.@) :: (HasTrie a, HasTrie b) =>+         (b :->: c) -> (a :->: b) -> (a :->: c)+(@.@) = inTrie2 (.)+++ -- instance Category (:->:) where---   id  = trie id---   (.) = inTrie2 (.)+--   id  = idTrie+--   (.) = (.:)  -- instance Arrow (:->:) where --   arr f = trie (arr f)@@ -372,9 +442,8 @@ Correctness of these instances follows by applying 'untrie' to each side of each definition and using the property @'untrie' . 'trie' == 'id'@. -The `Category` and `Arrow` instances don't quite work, however, however,-because of necessary but disallowed `HasTrie` constraints on the domain-type.+The `Category` and `Arrow` instances don't quite work, however, because of+necessary but disallowed `HasTrie` constraints on the domain type.  -}