cλash/CLasH/Utils.hs

   1 module CLasH.Utils where
   2
   3 -- Standard Imports
   4 import qualified Maybe
   5 import Data.Accessor
   6 import qualified Data.Accessor.Monad.Trans.State as MonadState
   7 import qualified Data.Map as Map
   8 import qualified Control.Monad as Monad
   9 import qualified Control.Monad.Trans.State as State
  10
  11 -- Make a caching version of a stateful computatation.
  12 makeCached :: (Monad m, Ord k) =>
  13   k -- ^ The key to use for the cache
  14   -> Accessor s (Map.Map k v) -- ^ The accessor to get at the cache
  15   -> State.StateT s m v -- ^ How to compute the value to cache?
  16   -> State.StateT s m v -- ^ The resulting value, from the cache or freshly
  17                         --   computed.
  18 makeCached key accessor create = do
  19   cache <- MonadState.get accessor
  20   case Map.lookup key cache of
  21     -- Found in cache, just return
  22     Just value -> return value
  23     -- Not found, compute it and put it in the cache
  24     Nothing -> do
  25       value <- create
  26       MonadState.modify accessor (Map.insert key value)
  27       return value
  28
  29 unzipM :: (Monad m) =>
  30   m [(a, b)]
  31   -> m ([a], [b])
  32 unzipM = Monad.liftM unzip
  33
  34 catMaybesM :: (Monad m) =>
  35   m [Maybe a]
  36   -> m [a]
  37 catMaybesM = Monad.liftM Maybe.catMaybes
  38
  39 concatM :: (Monad m) =>
  40   m [[a]]
  41   -> m [a]
  42 concatM = Monad.liftM concat
  43
  44 isJustM :: (Monad m) => m (Maybe a) -> m Bool
  45 isJustM = Monad.liftM Maybe.isJust
  46
  47 andM, orM :: (Monad m) => m [Bool] -> m Bool
  48 andM = Monad.liftM and
  49 orM = Monad.liftM or
  50
  51 -- | Monadic versions of any and all. We reimplement them, since there
  52 -- is no ready-made lifting function for them.
  53 allM, anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
  54 allM f = andM . (mapM f)
  55 anyM f = orM . (mapM f)
  56
  57 mapAccumLM :: (Monad m) => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
  58 mapAccumLM _ s []        =  return (s, [])
  59 mapAccumLM f s (x:xs)    =  do
  60   (s',  y ) <- f s x
  61   (s'', ys) <- mapAccumLM f s' xs
  62   return (s'', y:ys)