data-memocombinators-0.5.1/0000755000000000000000000000000012252773565014026 5ustar0000000000000000data-memocombinators-0.5.1/data-memocombinators.cabal0000644000000000000000000000074612252773565021126 0ustar0000000000000000Name: data-memocombinators Description: Combinators for building memo tables. Version: 0.5.1 Stability: experimental Synopsis: Combinators for building memo tables. License: BSD3 Category: Data Author: Luke Palmer Homepage: http://github.com/luqui/data-memocombinators Maintainer: lrpalmer@gmail.com Build-Type: Simple Build-Depends: base >= 3 && < 5, array, data-inttrie Exposed-Modules: Data.MemoCombinators, Data.MemoCombinators.Class Extensions: Rank2Types, ScopedTypeVariables data-memocombinators-0.5.1/Setup.lhs0000644000000000000000000000011612252773565015634 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain data-memocombinators-0.5.1/Data/0000755000000000000000000000000012252773565014677 5ustar0000000000000000data-memocombinators-0.5.1/Data/MemoCombinators.hs0000644000000000000000000001142212252773565020331 0ustar0000000000000000------------------------------------------------ -- | -- Module : Data.MemoCombinators -- Copyright : (c) Luke Palmer 2008-2010 -- License : BSD3 -- -- Maintainer : Luke Palmer -- Stability : experimental -- -- This module provides combinators for building memo tables -- over various data types, so that the type of table can -- be customized depending on the application. -- -- This module is designed to be imported /qualified/, eg. -- -- > import qualified Data.MemoCombinators as Memo -- -- Usage is straightforward: apply an object of type @Memo a@ -- to a function of type @a -> b@, and get a memoized function -- of type @a -> b@. For example: -- -- > fib = Memo.integral fib' -- > where -- > fib' 0 = 0 -- > fib' 1 = 1 -- > fib' x = fib (x-1) + fib (x-2) ------------------------------------------------ module Data.MemoCombinators ( Memo , wrap , memo2, memo3, memoSecond, memoThird , bool, char, list, boundedList, either, maybe, unit, pair , enum, integral, bits , switch , RangeMemo , arrayRange, unsafeArrayRange, chunks ) where import Prelude hiding (either, maybe) import Data.Bits import qualified Data.Array as Array import Data.Char (ord,chr) import qualified Data.IntTrie as IntTrie -- | The type of a memo table for functions of a. type Memo a = forall r. (a -> r) -> (a -> r) -- | Given a memoizer for a and an isomorphism between a and b, build -- a memoizer for b. wrap :: (a -> b) -> (b -> a) -> Memo a -> Memo b wrap i j m f = m (f . i) . j -- | Memoize a two argument function (just apply the table directly for -- single argument functions). memo2 :: Memo a -> Memo b -> (a -> b -> r) -> (a -> b -> r) memo2 a b = a . (b .) -- | Memoize a three argument function. memo3 :: Memo a -> Memo b -> Memo c -> (a -> b -> c -> r) -> (a -> b -> c -> r) memo3 a b c = a . (memo2 b c .) -- | Memoize the second argument of a function. memoSecond :: Memo b -> (a -> b -> r) -> (a -> b -> r) memoSecond b = (b .) -- | Memoize the third argument of a function. memoThird :: Memo c -> (a -> b -> c -> r) -> (a -> b -> c -> r) memoThird c = (memoSecond c .) bool :: Memo Bool bool f = cond (f True) (f False) where cond t f True = t cond t f False = f list :: Memo a -> Memo [a] list m f = table (f []) (m (\x -> list m (f . (x:)))) where table nil cons [] = nil table nil cons (x:xs) = cons x xs char :: Memo Char char = wrap chr ord integral -- | Build a table which memoizes all lists of less than the given length. boundedList :: Int -> Memo a -> Memo [a] boundedList 0 m f = f boundedList n m f = table (f []) (m (\x -> boundedList (n-1) m (f . (x:)))) where table nil cons [] = nil table nil cons (x:xs) = cons x xs either :: Memo a -> Memo b -> Memo (Either a b) either m m' f = table (m (f . Left)) (m' (f . Right)) where table l r (Left x) = l x table l r (Right x) = r x maybe :: Memo a -> Memo (Maybe a) maybe m f = table (f Nothing) (m (f . Just)) where table n j Nothing = n table n j (Just x) = j x unit :: Memo () unit f = let m = f () in \() -> m pair :: Memo a -> Memo b -> Memo (a,b) pair m m' f = uncurry (m (\x -> m' (\y -> f (x,y)))) -- | Memoize an enum type. enum :: (Enum a) => Memo a enum = wrap toEnum fromEnum integral -- | Memoize an integral type. integral :: (Integral a) => Memo a integral = wrap fromInteger toInteger bits -- | Memoize an ordered type with a bits instance. bits :: (Num a, Ord a, Bits a) => Memo a bits f = IntTrie.apply (fmap f IntTrie.identity) -- | @switch p a b@ uses the memo table a whenever p gives -- true and the memo table b whenever p gives false. switch :: (a -> Bool) -> Memo a -> Memo a -> Memo a switch p m m' f = table (m f) (m' f) where table t f x | p x = t x | otherwise = f x -- | The type of builders for ranged tables; takes a lower bound and an upper -- bound, and returns a memo table for that range. type RangeMemo a = (a,a) -> Memo a -- | Build a memo table for a range using a flat array. If items are -- given outside the range, don't memoize. arrayRange :: (Array.Ix a) => RangeMemo a arrayRange rng = switch (Array.inRange rng) (unsafeArrayRange rng) id -- | Build a memo table for a range using a flat array. If items are -- given outside the range, behavior is undefined. unsafeArrayRange :: (Array.Ix a) => RangeMemo a unsafeArrayRange rng f = (Array.listArray rng (map f (Array.range rng)) Array.!) -- | Given a list of ranges, (lazily) build a memo table for each one -- and combine them using linear search. chunks :: (Array.Ix a) => RangeMemo a -> [(a,a)] -> Memo a chunks rmemo cs f = lookup (cs `zip` map (\rng -> rmemo rng f) cs) where lookup [] _ = error "Element non in table" lookup ((r,c):cs) x | Array.inRange r x = c x | otherwise = lookup cs x data-memocombinators-0.5.1/Data/MemoCombinators/0000755000000000000000000000000012252773565017775 5ustar0000000000000000data-memocombinators-0.5.1/Data/MemoCombinators/Class.hs0000644000000000000000000001322112252773565021375 0ustar0000000000000000module Data.MemoCombinators.Class ( MemoTable(..) , Memoizable(..) ) where import qualified Data.MemoCombinators as Memo import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word, Word8, Word16, Word32, Word64) import Data.Ratio (Ratio, numerator, denominator, (%)) import Control.Arrow ((&&&)) -- | The class of types which have complete memo tables. class MemoTable a where table :: Memo.Memo a instance MemoTable Bool where table = Memo.bool instance MemoTable Char where table = Memo.char instance MemoTable Int where table = Memo.integral instance MemoTable Int8 where table = Memo.integral instance MemoTable Int16 where table = Memo.integral instance MemoTable Int32 where table = Memo.integral instance MemoTable Int64 where table = Memo.integral instance MemoTable Integer where table = Memo.integral instance MemoTable Ordering where table = Memo.enum instance MemoTable Word where table = Memo.integral instance MemoTable Word8 where table = Memo.integral instance MemoTable Word16 where table = Memo.integral instance MemoTable Word32 where table = Memo.integral instance MemoTable Word64 where table = Memo.integral instance MemoTable () where table = Memo.unit instance (MemoTable a, MemoTable b) => MemoTable (a,b) where table = uncurry . memoize . curry instance (MemoTable a, MemoTable b, MemoTable c) => MemoTable (a,b,c) where table f = \(a,b,c) -> m a b c where m = memoize (\a b c -> f (a,b,c)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d) => MemoTable (a,b,c,d) where table f = \(a,b,c,d) -> m a b c d where m = memoize (\a b c d -> f (a,b,c,d)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e) => MemoTable (a,b,c,d,e) where table f = \(a,b,c,d,e) -> m a b c d e where m = memoize (\a b c d e -> f (a,b,c,d,e)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f) => MemoTable (a,b,c,d,e,f) where table f = \(a,b,c,d,e,f') -> m a b c d e f' where m = memoize (\a b c d e f' -> f (a,b,c,d,e,f')) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g) => MemoTable (a,b,c,d,e,f,g) where table f = \(a,b,c,d,e,f',g) -> m a b c d e f' g where m = memoize (\a b c d e f' g -> f (a,b,c,d,e,f',g)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h) => MemoTable (a,b,c,d,e,f,g,h) where table f = \(a,b,c,d,e,f',g,h) -> m a b c d e f' g h where m = memoize (\a b c d e f' g h -> f (a,b,c,d,e,f',g,h)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h, MemoTable i) => MemoTable (a,b,c,d,e,f,g,h,i) where table f = \(a,b,c,d,e,f',g,h,i) -> m a b c d e f' g h i where m = memoize (\a b c d e f' g h i -> f (a,b,c,d,e,f',g,h,i)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h, MemoTable i, MemoTable j) => MemoTable (a,b,c,d,e,f,g,h,i,j) where table f = \(a,b,c,d,e,f',g,h,i,j) -> m a b c d e f' g h i j where m = memoize (\a b c d e f' g h i j -> f (a,b,c,d,e,f',g,h,i,j)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h, MemoTable i, MemoTable j, MemoTable k) => MemoTable (a,b,c,d,e,f,g,h,i,j,k) where table f = \(a,b,c,d,e,f',g,h,i,j,k) -> m a b c d e f' g h i j k where m = memoize (\a b c d e f' g h i j k -> f (a,b,c,d,e,f',g,h,i,j,k)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h, MemoTable i, MemoTable j, MemoTable k, MemoTable l) => MemoTable (a,b,c,d,e,f,g,h,i,j,k,l) where table f = \(a,b,c,d,e,f',g,h,i,j,k,l) -> m a b c d e f' g h i j k l where m = memoize (\a b c d e f' g h i j k l -> f (a,b,c,d,e,f',g,h,i,j,k,l)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h, MemoTable i, MemoTable j, MemoTable k, MemoTable l, MemoTable m) => MemoTable (a,b,c,d,e,f,g,h,i,j,k,l,m) where table f = \(a,b,c,d,e,f',g,h,i,j,k,l,m') -> m a b c d e f' g h i j k l m' where m = memoize (\a b c d e f' g h i j k l m' -> f (a,b,c,d,e,f',g,h,i,j,k,l,m')) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h, MemoTable i, MemoTable j, MemoTable k, MemoTable l, MemoTable m, MemoTable n) => MemoTable (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where table f = \(a,b,c,d,e,f',g,h,i,j,k,l,m',n) -> m a b c d e f' g h i j k l m' n where m = memoize (\a b c d e f' g h i j k l m' n -> f (a,b,c,d,e,f',g,h,i,j,k,l,m',n)) instance (MemoTable a, MemoTable b, MemoTable c, MemoTable d, MemoTable e, MemoTable f, MemoTable g, MemoTable h, MemoTable i, MemoTable j, MemoTable k, MemoTable l, MemoTable m, MemoTable n, MemoTable o) => MemoTable (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where table f = \(a,b,c,d,e,f',g,h,i,j,k,l,m',n,o) -> m a b c d e f' g h i j k l m' n o where m = memoize (\a b c d e f' g h i j k l m' n o -> f (a,b,c,d,e,f',g,h,i,j,k,l,m',n,o)) instance (MemoTable a) => MemoTable [a] where table = Memo.list table instance (MemoTable a) => MemoTable (Maybe a) where table = Memo.maybe table instance (MemoTable a, MemoTable b) => MemoTable (Either a b) where table = Memo.either table table instance (Integral a, MemoTable a) => MemoTable (Ratio a) where table = Memo.wrap (uncurry (%)) (numerator &&& denominator) table -- | The class of functions which can be completely memoized. class Memoizable a where memoize :: a -> a instance (MemoTable a) => Memoizable (a -> b) where memoize = table