MemoTrie 0.6.4 → 0.6.5

raw patch · 3 files changed

+63/−28 lines, 3 filesdep +newtype-genericsdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: newtype-generics

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• MemoTrie.cabal +4/−6
• examples/Generic.hs +13/−14
• src/Data/MemoTrie.hs +46/−8

@@ -1,17 +1,16 @@ Name:                MemoTrie-Version:             0.6.4+Version:             0.6.5 Cabal-Version:       >= 1.10 Synopsis:            Trie-based memo functions Category:            Data Description:   MemoTrie provides a basis for memoized functions over some domains,   using tries.  It's based on ideas from Ralf Hinze and code from-  Spencer Janssen.+  Spencer Janssen. Generic support thanks to Sam Boosalis.   .   Project wiki page: <http://haskell.org/haskellwiki/MemoTrie>   .   &#169; 2008-2015 by Conal Elliott; BSD3 license.-  Generic support thanks to Sam Boosalis. Homepage:            https://github.com/conal/MemoTrie Author:              Conal Elliott  Maintainer:          conal@conal.net@@ -34,15 +33,14 @@   hs-Source-Dirs:      src    if impl(ghc >= 7.10.0)-     Build-Depends: base >=4.8.0.0 && <5 +     Build-Depends: base >=4.8.0.0 && <5+                  , newtype-generics >= 0.4   else      Build-Depends: base <4.8.0.0, void    Exposed-Modules:                           Data.MemoTrie   Other-Modules:     --  ghc-prof-options:    -prof -auto-all     default-language: Haskell2010 

@@ -2,25 +2,24 @@ import Data.MemoTrie import GHC.Generics (Generic)  -data Color - = RGB Int Int Int- | Color String - deriving (Generic) +data Color = RGB Int Int Int+           | NamedColor String +  deriving (Generic)   instance HasTrie Color where- newtype (Color :->: b) = ColorTrie { unColorTrie :: Reg Color :->: b } - trie = trieGeneric ColorTrie - untrie = untrieGeneric unColorTrie- enumerate = enumerateGeneric unColorTrie+  newtype (Color :->: b) = ColorTrie { unColorTrie :: Reg Color :->: b } +  trie      = trieGeneric ColorTrie +  untrie    = untrieGeneric unColorTrie+  enumerate = enumerateGeneric unColorTrie  runColor (RGB r g b) = r + g + b-runColor (Color s) = length [1..10e7] +runColor (NamedColor s) = length [1..10e7]   runColorMemoized = memo runColor  -main = do - putStrLn "first call (should take a few seconds): " - print$ runColorMemoized (Color "")- putStrLn "cached call (should be instantaneous): " - print$ runColorMemoized (Color "") +main =+  do putStrLn "first call (should take a few seconds): " +     print$ runColorMemoized (NamedColor "")+     putStrLn "cached call (should be instantaneous): " +     print$ runColorMemoized (NamedColor "")  

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, TypeFamilies, TypeOperators, ScopedTypeVariables, CPP #-} {-# LANGUAGE StandaloneDeriving, FlexibleInstances #-} -{-# LANGUAGE DefaultSignatures, FlexibleContexts, EmptyCase, LambdaCase #-}+{-# LANGUAGE DefaultSignatures, FlexibleContexts, LambdaCase #-} {-# OPTIONS_GHC -Wall -fenable-rewrite-rules #-}  -- ScopedTypeVariables works around a 6.10 bug.  The forall keyword is@@ -42,7 +42,7 @@ -- see @examples/Generic.hs@, which can be run with:  --  -- @--- $ cabal configure -fexamples && cabal run generic+-- cabal configure -fexamples && cabal run generic -- @  --  -- @@ -64,12 +64,14 @@ import Data.Bits import Data.Word import Data.Int-import Control.Applicative+-- import Control.Applicative import Control.Arrow (first,(&&&))-import Data.Monoid+-- import Data.Monoid import Data.Function (on) import GHC.Generics +import Control.Newtype+ import Data.Void (Void)    -- import Prelude hiding (id,(.))@@ -128,8 +130,14 @@ -}  -{-# RULES "trie/untrie"   forall t. trie (untrie t) = t #-}+-- {-# RULES "trie/untrie"   forall t. trie (untrie t) = t #-} +--     warning: [-Winline-rule-shadowing] …+--     Rule "trie/untrie" may never fire+--       because rule "Class op untrie" for ‘untrie’ might fire first+--     Probable fix: add phase [n] or [~n] to the competing rule++ -- Don't include the dual rule: --   "untrie/trie"   forall f. untrie (trie f) = f -- which would defeat memoization.@@ -179,17 +187,28 @@  instance HasTrie Void where   -- As suggested by Audun Skaugen-  data Void :->: a = VoidTrie +  data Void :->: a = VoidTrie   trie _ = VoidTrie-  untrie VoidTrie = \case +  untrie VoidTrie = \ _ -> error "untrie VoidTrie"+                    -- \case  -- needs EmptyCase   enumerate VoidTrie = [] +instance Newtype (Void :->: a) where+  type O (Void :->: a) = ()+  pack () = VoidTrie+  unpack VoidTrie = ()+ instance HasTrie () where   newtype () :->: a = UnitTrie a   trie f = UnitTrie (f ())   untrie (UnitTrie a) = \ () -> a   enumerate (UnitTrie a) = [((),a)] +instance Newtype (() :->: a) where+  type O (() :->: a) = a+  pack a = UnitTrie a+  unpack (UnitTrie a) = a+ -- Proofs of inverse properties:  {-@@ -225,6 +244,11 @@   untrie (BoolTrie f t) = if' f t   enumerate (BoolTrie f t) = [(False,f),(True,t)] +instance Newtype (Bool :->: a) where+  type O (Bool :->: a) = (a,a)+  pack (a,a') = BoolTrie a a'+  unpack (BoolTrie a a') = (a,a')+ -- | Conditional with boolean last. -- Spec: @if' (f False) (f True) == f@ if' :: x -> x -> Bool -> x@@ -256,6 +280,11 @@   untrie (EitherTrie s t) = either (untrie s) (untrie t)   enumerate (EitherTrie s t) = enum' Left s `weave` enum' Right t +instance Newtype (Either a b :->: x) where+  type O (Either a b :->: x) = (a :->: x, b :->: x)+  pack (f,g) = EitherTrie f g+  unpack (EitherTrie f g) = (f,g)+ enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)] enum' f = (fmap.first) f . enumerate @@ -295,6 +324,11 @@   enumerate (PairTrie tt) =     [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ] +instance Newtype ((a,b) :->: x) where+  type O ((a,b) :->: x) = a :->: b :->: x+  pack abx = PairTrie abx+  unpack (PairTrie abx) = abx+ {-     untrie (trie f)       == { trie def }@@ -563,7 +597,8 @@ instance HasTrie (V1 x) where   data (V1 x :->: b) = V1Trie    trie _ = V1Trie -  untrie V1Trie = \case +  untrie V1Trie = \ _ -> error "untrie V1Trie"+                  -- \case  -- needs EmptyCase   enumerate V1Trie = []   -- | just like @()@ @@ -605,6 +640,7 @@ -- "unlifted" generic representation. (i.e. is a unary type constructor).  type Reg a = Rep a ()  +-- | 'Generic'-friendly default for 'trie' trieGeneric :: (Generic a, HasTrie (Reg a))             => ((Reg a :->: b) -> (a :->: b))             -> (a -> b)@@ -612,6 +648,7 @@ trieGeneric theConstructor f = theConstructor (trie (f . to)) {-# INLINEABLE trieGeneric #-} +-- | 'Generic'-friendly default for 'untrie' untrieGeneric :: (Generic a, HasTrie (Reg a))               => ((a :->: b) -> (Reg a :->: b))               -> (a :->: b)@@ -619,6 +656,7 @@ untrieGeneric theDestructor t = \a -> (untrie (theDestructor t)) (from a) {-# INLINEABLE untrieGeneric #-} +-- | 'Generic'-friendly default for 'enumerate' enumerateGeneric :: (Generic a, HasTrie (Reg a))                  => ((a :->: b) -> (Reg a :->: b))                  -> (a :->: b)