monad-memo 0.5.0 → 0.5.1

raw patch · 10 files changed

+418/−138 lines, 10 filesdep +transformers-compatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers-compat

API changes (from Hackage documentation)

Files

• CHANGES +4/−0
• Control/Monad/Memo/Array.hs +6/−2
• Control/Monad/Memo/Vector/Expandable.hs +0/−2
• Control/Monad/Trans/Memo/ReaderCache.hs +43/−3
• Control/Monad/Trans/Memo/StateCache.hs +45/−1
• README.md +3/−0
• benchmark/Main.hs +126/−75
• example/Basic.hs +1/−1
• monad-memo.cabal +15/−2
• test/MemoTest.hs +175/−52

@@ -22,3 +22,7 @@ - Use `Except` instead of depricated `Error` - Remove support for `ListT` transformer since it is now depricated - Use standard `StateT` & `ReaderT` for `MonadCache` implementations++0.5.1+- Support multiple mutable caches in transformers stack+  This allows Array/Vector-based caches to be used for mutually recursive function memoization

@@ -50,9 +50,7 @@ import Data.Maybe (Maybe(..)) import Data.Array.ST import Data.Array.IO-import Control.Applicative import Control.Monad-import Control.Monad.Fix import Control.Monad.Trans.Class import Control.Monad.ST import System.IO@@ -102,6 +100,9 @@ type instance Array (ST s) = STArray s type instance Array IO = IOArray +type instance Array (ReaderCache c (ST s)) = STArray s+type instance Array (ReaderCache c IO) = IOArray+ -- | Memoization monad based on mutable boxed array type ArrayCache k e m = Cache (Array m) k e m @@ -141,6 +142,9 @@  type instance UArray (ST s) = STUArray s type instance UArray IO = IOUArray++type instance UArray (ReaderCache c (ST s)) = STUArray s+type instance UArray (ReaderCache c IO) = IOUArray  -- | Memoization monad based on mutable unboxed array type UArrayCache k e m = Cache (UArray m) k e m

@@ -47,9 +47,7 @@ import Data.Vector.Generic.Mutable import qualified Data.Vector.Mutable as M import qualified Data.Vector.Unboxed.Mutable as UM-import Control.Applicative import Control.Monad-import Control.Monad.Fix import Control.Monad.Trans.Class import Control.Monad.Primitive 

@@ -11,7 +11,8 @@  -} -{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts,+    TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-}  module Control.Monad.Trans.Memo.ReaderCache (@@ -22,22 +23,61 @@  ) where -import Data.Function import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Control.Monad.Fix+import Control.Monad.Primitive+import Control.Monad.ST import Control.Monad.Trans.Class import Control.Monad.Trans.Reader-+import Data.Array.Base+import Data.Array.IO+import Data.Array.ST  newtype ReaderCache c m a = ReaderCache { toReaderT :: ReaderT c m a }     deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix, MonadTrans, MonadIO)  {-# INLINE evalReaderCache #-}+evalReaderCache :: ReaderCache r m a -> r -> m a evalReaderCache = runReaderT . toReaderT  -- | Returns internal container container :: Monad m => ReaderCache c m c {-# INLINE container #-} container = ReaderCache ask+++instance PrimMonad m => PrimMonad (ReaderCache c m) where+  type PrimState (ReaderCache c m) = PrimState m+  primitive = lift . primitive+++instance MArray IOArray e (ReaderCache c IO) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i++instance MArray IOUArray e IO => MArray IOUArray e (ReaderCache c IO) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i+++instance MArray (STArray s) e (ReaderCache c (ST s)) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i++instance MArray (STUArray s) e (ST s) => MArray (STUArray s) e (ReaderCache c (ST s)) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i

@@ -11,7 +11,8 @@  -} -{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies,+  MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}  module Control.Monad.Trans.Memo.StateCache ( @@ -22,6 +23,9 @@     evalStateCache ) where +import Control.Monad.Primitive+import Control.Monad.ST+import Data.Array.MArray import Data.Function import Control.Applicative import Control.Monad@@ -29,12 +33,17 @@ import Control.Monad.Fix import Control.Monad.Trans.Class import Control.Monad.Trans.State.Strict+import Data.Array.Base+import Data.Array.IO+import Data.Array.ST  + newtype StateCache c m a = StateCache { toStateT :: StateT c m a }     deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix, MonadTrans, MonadIO)  {-# INLINE runStateCache #-}+runStateCache :: StateCache s m a -> s -> m (a, s) runStateCache = runStateT . toStateT  -- | Evaluates computation discarding the resulting container @@ -51,3 +60,38 @@ setContainer :: Monad m => c -> StateCache c m () {-# INLINE setContainer #-} setContainer = StateCache . put+++instance PrimMonad m => PrimMonad (StateCache c m) where+  type PrimState (StateCache c m) = PrimState m+  primitive = lift . primitive+++instance MArray IOArray e (StateCache c IO) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i++instance MArray IOUArray e IO => MArray IOUArray e (StateCache c IO) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i+++instance MArray (STArray s) e (StateCache c (ST s)) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i++instance MArray (STUArray s) e (ST s) => MArray (STUArray s) e (StateCache c (ST s)) where+  getBounds = lift . getBounds+  getNumElements = lift . getNumElements+  newArray a = lift . newArray a+  unsafeRead a = lift . unsafeRead a+  unsafeWrite a i = lift . unsafeWrite a i

@@ -1,3 +1,6 @@+# monad-memo+[![Build Status](https://travis-ci.org/EduardSergeev/monad-memo.svg?branch=master)](https://travis-ci.org/EduardSergeev/monad-memo)+ ## Purpose This package provides a convenient mechanism for adding memoization to Haskell monadic functions. 

@@ -3,12 +3,13 @@ module Main (main) where  import Data.Int-import Data.Word import Data.List+import Data.Word import qualified Data.IntMap as IM import Data.Array import Control.Monad.ST import Control.Monad.Memo+import Control.Monad.Memo.Class import Control.Monad.Memo.Vector.Unsafe import Control.Monad.Memo.Vector.Expandable import Criterion.Main@@ -18,6 +19,7 @@ --------------------  {-# INLINE fibm #-}+fibm :: (Eq k, Num k, Num v, MonadMemo k v m) => k -> m v fibm 0 = return 0 fibm 1 = return 1 fibm n = do@@ -45,29 +47,29 @@   fibIOV :: Int -> IO Word-fibIOV n = evalVectorMemo (fibm n) n+fibIOV n = evalVectorMemo (fibm n) (n+1)  fibIOUV :: Int -> IO Word-fibIOUV n = evalUVectorMemo (fibm n) n+fibIOUV n = evalUVectorMemo (fibm n) (n+1)  fibSTV :: Int -> Word-fibSTV n = runST $ evalVectorMemo (fibm n) n+fibSTV n = runST $ evalVectorMemo (fibm n) (n+1)  fibSTUV :: Int -> Word-fibSTUV n = runST $ evalUVectorMemo (fibm n) n+fibSTUV n = runST $ evalUVectorMemo (fibm n) (n+1)   fibIOVU :: Int -> IO Word-fibIOVU n = unsafeEvalVectorMemo (fibm n) n+fibIOVU n = unsafeEvalVectorMemo (fibm n) (n+1)  fibIOUVU :: Int -> IO Word-fibIOUVU n = unsafeEvalUVectorMemo (fibm n) n+fibIOUVU n = unsafeEvalUVectorMemo (fibm n) (n+1)  fibSTVU :: Int -> Word-fibSTVU n = runST $ unsafeEvalVectorMemo (fibm n) n+fibSTVU n = runST $ unsafeEvalVectorMemo (fibm n) (n+1)  fibSTUVU :: Int -> Word-fibSTUVU n = runST $ unsafeEvalUVectorMemo (fibm n) n+fibSTUVU n = runST $ unsafeEvalUVectorMemo (fibm n) (n+1)   fibIOVE :: Int -> IO Word@@ -87,7 +89,8 @@ -----------------------  {-# INLINE knap #-}-knap ws vs w = m (l-1) w+knap :: MonadMemo (Int, Int) Int m => [Int] -> [Int] -> Int -> m Int+knap ws vs = m (l-1)     where       l = length ws       wa = listArray (0,l-1) ws@@ -165,9 +168,7 @@         l2 <- mlcs ia (ib-1)         return (l1 `max` l2)       mlcs ai bi =-          memo (\abi -> -                    let (!ai,!bi) = abi `quotRem` lb-                    in lcs ai bi) (ai*lb + bi)+          memo (\abi -> uncurry lcs $! abi `quotRem` lb) (ai*lb + bi)  lcsIM :: [Int] -> [Int] -> Int lcsIM as bs = evalMemoState (lcsm as bs) IM.empty@@ -179,68 +180,118 @@ lcsSTUVE as bs = runST $ startEvalUVectorMemo (lcsm as bs)  +-- | Hofstadter Female and Male sequences+-- Mutually recursive memoized functions +gof :: (MonadTrans t, MonadCache Int Int m, MonadCache Int Int (t m)) => Int -> t m Int+gof 0 = return 1+gof i = do+  fs <- memol0 gof (i-1)+  ms <- memol1 gom fs+  return (i - ms)++gom :: (MonadTrans t, MonadCache Int Int m, MonadCache Int Int (t m)) => Int -> t m Int+gom 0 = return 0+gom i = do+  ms <- memol1 gom (i-1)+  fs <- memol0 gof ms+  return (i - fs)++fM :: Int -> Int+fM = startEvalMemo . startEvalMemoT . gof++fSTA :: Int -> Int+fSTA n = runST $ (`evalArrayMemo`(0,n)) . (`evalArrayMemo`(0,n)) . gof $ n++fSTAU :: Int -> Int+fSTAU n = runST $ (`evalUArrayMemo`(0,n)) . (`evalUArrayMemo`(0,n)) . gof $ n++fSTV :: Int -> Int+fSTV n = runST $ (`evalVectorMemo`(n+1)) . (`evalVectorMemo`(n+1)) . gof $ n++fSTVU :: Int -> Int+fSTVU n = runST $ (`evalUVectorMemo`(n+1)) . (`evalUVectorMemo`(n+1)) . gof $ n++fSTVUU :: Int -> Int+fSTVUU n = runST $ (`unsafeEvalUVectorMemo`(n+1)) . (`unsafeEvalUVectorMemo`(n+1)) . gof $ n+++main :: IO () main = defaultMainWith defaultConfig [-         bgroup "fib" [-           bgroup "pure" [-             bench "Map" $ whnf fibM n-           , bench "IntMap" $ whnf fibIM n-           ]-         , bgroup "ST" [-             bench "Array" $ whnf fibSTA n-           , bench "UArray" $ whnf fibSTUA n-           , bench "Vector" $ whnf fibSTV n-           , bench "UVector" $ whnf fibSTUV n-           , bench "Vector unsafe" $ whnf fibSTVU n-           , bench "UVector unsafe" $ whnf fibSTUVU n-           , bench "Vector exp" $ whnf fibSTVE n-           , bench "UVector exp" $ whnf fibSTUVE n-           ]-         , bgroup "IO" [-             bench "Array" $ whnfIO (fibIOA n)-           , bench "UArray" $ whnfIO (fibIOUA n)-           , bench "Vector" $ whnfIO (fibIOV n)-           , bench "UVector" $ whnfIO (fibIOUV n)-           , bench "Vector unsafe" $ whnfIO (fibIOVU n)-           , bench "UVector unsafe" $ whnfIO (fibIOUVU n)-           , bench "Vector exp" $ whnfIO (fibIOVE n)-           , bench "UVector exp" $ whnfIO (fibIOUVE n)-           ]-         ]-       , bgroup "knapsack" [-          bgroup "pure" [-             bench "Map" $ whnf (knapM ws vs) w-          ]-        , bgroup "ST" [-             bench "Array" $ whnf (knapSTA ws vs) w-           , bench "UArray" $ whnf (knapSTUA ws vs) w-          ]-        , bgroup "IO" [-             bench "Array" $ whnfIO (knapIOA ws vs w)-           , bench "UArray" $ whnfIO (knapIOUA ws vs w)-          ]-         ]-       , bgroup "LCS" [-          bgroup "pure" [-             bench "Map" $ whnf (lcsM as) bs-           , bench "IntMap" $ whnf (lcsIM as) bs-          ]-        , bgroup "ST" [-             bench "Array" $ whnf (lcsSTA as) bs-           , bench "UArray" $ whnf (lcsSTUA as) bs-           , bench "UVector exp" $ whnf (lcsSTUVE as) bs-           , bench "UVector" $ whnf (lcsSTUV as) bs-         ]-        ]-       ]-    where-      -- fib arg-      n = 100000-      -- knapsac args-      ws = [1..200]-      vs = [1..200]-      w = 800-      -- LCS args-      as = [1..400]-      bs = [100,102..800]+    bgroup "fib" [+      bgroup "pure" [+        bench "Map" $ whnf fibM n+      , bench "IntMap" $ whnf fibIM n+      ]+    , bgroup "ST" [+        bench "Array" $ whnf fibSTA n+      , bench "UArray" $ whnf fibSTUA n+      , bench "Vector" $ whnf fibSTV n+      , bench "UVector" $ whnf fibSTUV n+      , bench "Vector unsafe" $ whnf fibSTVU n+      , bench "UVector unsafe" $ whnf fibSTUVU n+      , bench "Vector exp" $ whnf fibSTVE n+      , bench "UVector exp" $ whnf fibSTUVE n+      ]+    , bgroup "IO" [+        bench "Array" $ whnfIO (fibIOA n)+      , bench "UArray" $ whnfIO (fibIOUA n)+      , bench "Vector" $ whnfIO (fibIOV n)+      , bench "UVector" $ whnfIO (fibIOUV n)+      , bench "Vector unsafe" $ whnfIO (fibIOVU n)+      , bench "UVector unsafe" $ whnfIO (fibIOUVU n)+      , bench "Vector exp" $ whnfIO (fibIOVE n)+      , bench "UVector exp" $ whnfIO (fibIOUVE n)+      ]+    ]+  , bgroup "knapsack" [+      bgroup "pure" [+          bench "Map" $ whnf (knapM ws vs) w+      ]+    , bgroup "ST" [+          bench "Array" $ whnf (knapSTA ws vs) w+        , bench "UArray" $ whnf (knapSTUA ws vs) w+      ]+    , bgroup "IO" [+          bench "Array" $ whnfIO (knapIOA ws vs w)+        , bench "UArray" $ whnfIO (knapIOUA ws vs w)+      ]+    ]+  , bgroup "LCS" [+      bgroup "pure" [+          bench "Map" $ whnf (lcsM as) bs+        , bench "IntMap" $ whnf (lcsIM as) bs+      ]+    , bgroup "ST" [+          bench "Array" $ whnf (lcsSTA as) bs+        , bench "UArray" $ whnf (lcsSTUA as) bs+        , bench "UVector exp" $ whnf (lcsSTUVE as) bs+        , bench "UVector" $ whnf (lcsSTUV as) bs+      ]+    ]+  , bgroup "Hofstadter" [+      bgroup "pure" [+          bench "Map" $ whnf fM fn+      ]+    , bgroup "ST" [+          bench "Array" $ whnf fSTA fn+        , bench "UArray" $ whnf fSTAU fn+        , bench "Vector" $ whnf fSTV fn+        , bench "UVector" $ whnf fSTVU fn+        , bench "UVector unsafe" $ whnf fSTVUU fn+      ]+    ]+  ]+  where+    -- fib arg+    n = 100000+    -- knapsac args+    ws = [1..200]+    vs = [1..200]+    w = 800+    -- LCS args+    as = [1..400]+    bs = [100,102..800]+    -- Hofstadter+    fn = 100000            

@@ -287,7 +287,7 @@  evalFibmwSTA n = runST $ evalArrayMemo (runWriterT (fibmw n)) (0,n) -evalFibmwSTV n = runST $ evalVectorMemo (runWriterT (fibmw n)) n+evalFibmwSTV n = runST $ evalVectorMemo (runWriterT (fibmw n)) (n+1)  runFibmwST :: Integer -> ((Integer,String), Array Integer (Maybe (Integer,String))) runFibmwST n = runST $ do

@@ -1,6 +1,6 @@ Name:               monad-memo -Version:            0.5.0+Version:            0.5.1  -- A short (one-line) description of the package. Synopsis:           Memoization monad transformer@@ -52,7 +52,11 @@ -- Constraint on the version of Cabal needed to build this package. Cabal-version:      >=1.10 -Tested-with:        GHC==7.10.3, GHC==8.2.2, GHC==8.4.3+Tested-with:+  GHC==7.8.4,+  GHC==7.10.3,+  GHC==8.2.2,+  GHC==8.4.3  Extra-source-files:   CHANGES,@@ -80,6 +84,9 @@           array >= 0.3,           vector >= 0.7,           primitive >= 0.3+  if impl(ghc < 7.10)+    build-depends:+          transformers-compat >= 0.3   exposed-modules:           Control.Monad.Memo,           Control.Monad.Memo.Class,@@ -114,6 +121,9 @@           QuickCheck >= 2.0,           test-framework-quickcheck2 >= 0.2.9,           test-framework >= 0.3.3+  if impl(ghc < 7.10)+    build-depends:+          transformers-compat >= 0.3   other-modules:           Control.Monad.Memo,           Control.Monad.Memo.Class,@@ -146,6 +156,9 @@           vector >= 0.7,           primitive >= 0.3,           criterion >= 0.6+  if impl(ghc < 7.10)+    build-depends:+          transformers-compat >= 0.3   other-modules:           Control.Monad.Memo,           Control.Monad.Memo.Class,

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE FlexibleInstances, FlexibleContexts #-}  module MemoTest@@ -15,7 +16,7 @@ import Test.QuickCheck import Test.QuickCheck.Monadic import System.Random-import Test.Framework (defaultMain, testGroup)+import Test.Framework (testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)  import Control.Monad.Memo@@ -84,9 +85,9 @@ runFibmr r = startEvalMemo . (`runReaderT`r) . fibmr  -prop_ReaderEqv :: SmallInt Int -> SmallInt Int -> Bool+prop_ReaderEqv :: SmallInt Int -> SmallInt Int -> Property prop_ReaderEqv (SmallInt r) (SmallInt n) =-    ((`runReader` r) . fibr  $ n) == (startEvalMemo . (`runReaderT` r) . fibmr $ n)+    runFibr r n === runFibmr r n  prop_ReaderSTEqv :: SmallInt Integer -> SmallInt Integer -> Bool prop_ReaderSTEqv (SmallInt r) (SmallInt n) =@@ -152,7 +153,7 @@   s <- get   f1 <- fibs (n-1)   f2 <- fibs (n-2)-  modify $ \s -> s+1+  modify (+1)   return (f1+f2+s)  fibms 0 = return 0@@ -161,7 +162,7 @@   s <- get   f1 <- memo fibms (n-1)   f2 <- memo fibms (n-2)-  modify $ \s -> s+1+  modify (+1)   return (f1+f2+s)  prop_StateEqv :: SmallInt Int -> SmallInt Int -> Bool@@ -210,6 +211,7 @@         x = toInt sx         y = toInt sy + -- Same as above but without explicit uncurring fm2 :: Int -> MemoFG (Int,String) fm2 0 = return (1,"+")@@ -226,8 +228,8 @@   return $ fst fn - g  evalAll2 = startEvalMemo . startEvalMemoT-evalFm2 = evalAll . fm2-evalGm2 n m = evalAll $ gm2 n m+evalFm2 = evalAll2 . fm2+evalGm2 n m = evalAll2 $ gm2 n m   prop_Mutual2FEqv :: SmallInt Int -> Bool@@ -255,9 +257,6 @@ fibSTUA :: Int -> Int fibSTUA n = runST $ evalUArrayMemo (fibm n) (0,n) -fibSTUAD :: Int -> Double-fibSTUAD n = runST $ evalUArrayMemo (fibm n) (0,n)- fibIOA :: Integer -> IO Integer fibIOA n = evalArrayMemo (fibm n) (0,n) @@ -292,19 +291,19 @@ -----------------  fibSTV :: Int -> Integer-fibSTV n = runST $ evalVectorMemo (fibm n) n+fibSTV n = runST $ evalVectorMemo (fibm n) (n+1)  prop_STVEqv :: MedInt Int -> Bool prop_STVEqv (MedInt n) = fibMap n == fibSTV n  fibSTUV :: Int -> Int-fibSTUV n = runST $ evalUVectorMemo (fibm n) n+fibSTUV n = runST $ evalUVectorMemo (fibm n) (n+1)  prop_STUVEqv :: MedInt Int -> Bool prop_STUVEqv (MedInt n) = fibMap n == fibSTUV n  fibIOV :: Int -> IO Integer-fibIOV n = evalVectorMemo (fibm n) n+fibIOV n = evalVectorMemo (fibm n) (n+1)  prop_IOVEqv :: MedInt Int -> Property prop_IOVEqv (MedInt n) = monadicIO $ do@@ -312,7 +311,7 @@                            assert $ r == fibMap n  fibIOUV :: Int -> IO Int-fibIOUV n = evalUVectorMemo (fibm n) n+fibIOUV n = evalUVectorMemo (fibm n) (n+1)  prop_IOUVEqv :: MedInt Int -> Property prop_IOUVEqv (MedInt n) = monadicIO $ do@@ -355,19 +354,19 @@ ------------------------  fibSTUSV :: Int -> Integer-fibSTUSV n = runST $ UV.unsafeEvalVectorMemo (fibm n) n+fibSTUSV n = runST $ UV.unsafeEvalVectorMemo (fibm n) (n+1)  prop_STUSVEqv :: MedInt Int -> Bool prop_STUSVEqv (MedInt n) = fibMap n == fibSTUSV n  fibSTUSUV :: Int -> Int-fibSTUSUV n = runST $ UV.unsafeEvalUVectorMemo (fibm n) n+fibSTUSUV n = runST $ UV.unsafeEvalUVectorMemo (fibm n) (n+1)  prop_STUSUVEqv :: MedInt Int -> Bool prop_STUSUVEqv (MedInt n) = fibMap n == fibSTUSUV n  fibIOUSV :: Int -> IO Integer-fibIOUSV n = UV.unsafeEvalVectorMemo (fibm n) n+fibIOUSV n = UV.unsafeEvalVectorMemo (fibm n) (n+1)  prop_IOUSVEqv :: MedInt Int -> Property prop_IOUSVEqv (MedInt n) = monadicIO $ do@@ -375,7 +374,7 @@                            assert $ r == fibMap n  fibIOUSUV :: Int -> IO Int-fibIOUSUV n = UV.unsafeEvalUVectorMemo (fibm n) n+fibIOUSUV n = UV.unsafeEvalUVectorMemo (fibm n) (n+1)  prop_IOUSUVEqv :: MedInt Int -> Property prop_IOUSUVEqv (MedInt n) = monadicIO $ do@@ -383,39 +382,163 @@                            assert $ r == fibMap n  +-- | Hofstadter Female and Male sequences+-- Mutually recursive functions++hf :: Int -> Int+hf n =+  gof n+  where+    gof 0 = 1+    gof i = i - ms !! (fs !! (i-1))+    gom 0 = 0+    gom i = i - fs !! (ms !! (i-1))+    fs = [gof j | j <- [0..n]]+    ms = [gom j | j <- [0..n]]++-- hfm :: a -> t1 m a+hfm n = gof n+  where+    gof 0 = return 1+    gof i = do+      fs <- memol0 gof (i-1)+      ms <- memol1 gom fs+      return (i - ms)+    gom 0 = return 0+    gom i = do+      ms <- memol1 gom (i-1)+      fs <- memol0 gof ms+      return (i - fs)++hfM :: Int -> Int+hfM = startEvalMemo . startEvalMemoT . hfm++prop_hfMEqv :: MedInt Int -> Property+prop_hfMEqv (MedInt n) =+  hfM n === hf n+++hfIOA :: Int -> IO Int+hfIOA n = (`evalArrayMemo`(0,n)) . (`evalArrayMemo`(0,n)) . hfm $ n++hfIOAU :: Int -> IO Int+hfIOAU n = (`evalUArrayMemo`(0,n)) . (`evalUArrayMemo`(0,n)) . hfm $ n++hfSTA :: Int -> Int+hfSTA n = runST $ (`evalArrayMemo`(0,n)) . (`evalArrayMemo`(0,n)) . hfm $ n++hfSTAU :: Int -> Int+hfSTAU n = runST $ (`evalUArrayMemo`(0,n)) . (`evalUArrayMemo`(0,n)) . hfm $ n++hfIOV :: Int -> IO Int+hfIOV n = (`evalVectorMemo`(n+1)) . (`evalVectorMemo`(n+1)) . hfm $ n++hfIOVU :: Int -> IO Int+hfIOVU n = (`evalUVectorMemo`(n+1)) . (`evalUVectorMemo`(n+1)) . hfm $ n++hfSTV :: Int -> Int+hfSTV n = runST $ (`evalVectorMemo`(n+1)) . (`evalVectorMemo`(n+1)) . hfm $ n++hfSTVU :: Int -> Int+hfSTVU n = runST $ (`evalUVectorMemo`(n+1)) . (`evalUVectorMemo`(n+1)) . hfm $ n++hfSTVE :: Int -> Int+hfSTVE n = runST $ (EV.startEvalVectorMemo) . (EV.startEvalVectorMemo) . hfm $ n++hfSTVUE :: Int -> Int+hfSTVUE n = runST $ (EV.startEvalUVectorMemo) . (EV.startEvalUVectorMemo) . hfm $ n++prop_hfIOEqv :: MedInt Int -> Property+prop_hfIOEqv (MedInt n) = monadicIO $ do+  hfIOAn <- run $ hfIOA n+  hfIOAUn <- run $ hfIOAU n+  hfIOVn <- run $ hfIOV n+  hfIOVUn <- run $ hfIOVU n+  return $+    hfIOAn === hfn .&&.+    hfIOAUn === hfn .&&.+    hfIOVn === hfn .&&.+    hfIOVUn === hfn+  where+    hfn = hf n++prop_hfSTAEqv :: MedInt Int -> Property+prop_hfSTAEqv (MedInt n) =+  hfSTA n === hf n++prop_hfSTAUEqv :: MedInt Int -> Property+prop_hfSTAUEqv (MedInt n) =+  hfSTAU n === hf n++prop_hfSTVEqv :: MedInt Int -> Property+prop_hfSTVEqv (MedInt n) =+  hfSTV n === hf n++prop_hfSTVUEqv :: MedInt Int -> Property+prop_hfSTVUEqv (MedInt n) =+  hfSTVU n === hf n++prop_hfSTVEEqv :: MedInt Int -> Property+prop_hfSTVEEqv (MedInt n) =+  hfSTVE n === hf n++prop_hfSTVUEEqv :: MedInt Int -> Property+prop_hfSTVUEEqv (MedInt n) =+  hfSTVUE n === hf n+ tests = [-        testGroup "Transformers" [-                       testProperty "ReaderEqv"         prop_ReaderEqv,-                       testProperty "ReaderSTEqv"       prop_ReaderSTEqv,-                       testProperty "WriterEqv"         prop_WriterEqv,-                       testProperty "ContEqv"           prop_ContEqv,-                       testProperty "ContSTUEqv"        prop_ContSTUEqv,-                       testProperty "StateEqv"          prop_StateEqv-                      ],-        testGroup "Others" [-                       testProperty "MutualFGEqv"       prop_MutualFEqv,-                       testProperty "MutualCurryFGEqv"  prop_Mutual2FEqv-                       ],-        testGroup "Different memo-caches" [-                       testGroup "ArrayCache" [-                                      testProperty "Data.IntMap cache" prop_IntMapEqv,-                                      testProperty "STArray cache"     prop_STAEqv,-                                      testProperty "STUArray cache"    prop_STUAEqv,-                                      testProperty "STUArray Double"   prop_STUADEqv,-                                      testProperty "IOArray cache"     prop_IOAEqv,-                                      testProperty "IOUArray cache"    prop_IOUAEqv-                                     ],-                       testGroup "VectorCache" [-                                      testProperty "STVector cache"    prop_STVEqv,-                                      testProperty "STUVector cache"   prop_STUVEqv,-                                      testProperty "IOVector cache"    prop_IOVEqv,-                                      testProperty "IOUVector cache"   prop_IOUVEqv-                                     ],-                       testGroup "Expandable VectorCache" [-                                      testProperty "Exp STVector cache"    prop_STEVEqv,-                                      testProperty "Exp STUVector cache"   prop_STEUVEqv,-                                      testProperty "Exp IOVector cache"    prop_IOEVEqv,-                                      testProperty "Exp IOUVector cache"   prop_IOEUVEqv-                                     ]-                      ]+    testGroup "Transformers" [+      testProperty "ReaderEqv"         prop_ReaderEqv,+      testProperty "ReaderSTEqv"       prop_ReaderSTEqv,+      testProperty "WriterEqv"         prop_WriterEqv,+      testProperty "ContEqv"           prop_ContEqv,+      testProperty "ContSTUEqv"        prop_ContSTUEqv,+      testProperty "StateEqv"          prop_StateEqv+    ],+    testGroup "Others" [+      testProperty "MutualFEqv"        prop_MutualFEqv,+      testProperty "MutualGEqv"        prop_MutualGEqv,+      testProperty "MutualCurryFEqv"   prop_Mutual2FEqv,+      testProperty "MutualCurryGEqv"   prop_Mutual2GEqv,+      testGroup "Hofstadter" [+        testProperty "Map"             prop_hfMEqv,+        testProperty "IO (Arr & Vec)"  prop_hfIOEqv,+        testGroup "ST" [+          testProperty "Vector"      prop_hfSTVEqv,+          testProperty "UVector"     prop_hfSTVUEqv,+          testProperty "Array"       prop_hfSTAEqv,+          testProperty "UArray"      prop_hfSTAUEqv,+          testProperty "Vector exp"  prop_hfSTVEEqv,+          testProperty "UVector exp" prop_hfSTVUEEqv+        ]+      ]+    ],+    testGroup "Different memo-caches" [+      testGroup "ArrayCache" [+        testProperty "Data.IntMap cache" prop_IntMapEqv,+        testProperty "STArray cache"     prop_STAEqv,+        testProperty "STUArray cache"    prop_STUAEqv,+        testProperty "STUArray Double"   prop_STUADEqv,+        testProperty "IOArray cache"     prop_IOAEqv,+        testProperty "IOUArray cache"    prop_IOUAEqv+      ],+      testGroup "VectorCache" [+        testProperty "STVector cache"    prop_STVEqv,+        testProperty "STUVector cache"   prop_STUVEqv,+        testProperty "IOVector cache"    prop_IOVEqv,+        testProperty "IOUVector cache"   prop_IOUVEqv+      ],+      testGroup "Expandable VectorCache" [+        testProperty "STVector cache"    prop_STEVEqv,+        testProperty "STUVector cache"   prop_STEUVEqv,+        testProperty "IOVector cache"    prop_IOEVEqv,+        testProperty "IOUVector cache"   prop_IOEUVEqv+      ],+      testGroup "Unsafe VectorCache" [+        testProperty "STVector cache"    prop_STUSVEqv,+        testProperty "STUVector cache"   prop_STUSUVEqv,+        testProperty "IOVector cache"    prop_IOUSVEqv,+        testProperty "IOUVector cache"   prop_IOUSUVEqv+      ]     ]+  ]