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 import qualified Debug.Trace as Trace
  11
  12 -- Make a caching version of a stateful computatation.
  13 makeCached :: (Monad m, Ord k) =>
  14   k -- ^ The key to use for the cache
  15   -> Accessor s (Map.Map k v) -- ^ The accessor to get at the cache
  16   -> State.StateT s m v -- ^ How to compute the value to cache?
  17   -> State.StateT s m v -- ^ The resulting value, from the cache or freshly
  18                         --   computed.
  19 makeCached key accessor create = do
  20   cache <- MonadState.get accessor
  21   case Map.lookup key cache of
  22     -- Found in cache, just return
  23     Just value -> return value
  24     -- Not found, compute it and put it in the cache
  25     Nothing -> do
  26       value <- create
  27       MonadState.modify accessor (Map.insert key value)
  28       return value
  29
  30 unzipM :: (Monad m) =>
  31   m [(a, b)]
  32   -> m ([a], [b])
  33 unzipM = Monad.liftM unzip
  34
  35 catMaybesM :: (Monad m) =>
  36   m [Maybe a]
  37   -> m [a]
  38 catMaybesM = Monad.liftM Maybe.catMaybes
  39
  40 concatM :: (Monad m) =>
  41   m [[a]]
  42   -> m [a]
  43 concatM = Monad.liftM concat
  44
  45 isJustM :: (Monad m) => m (Maybe a) -> m Bool
  46 isJustM = Monad.liftM Maybe.isJust
  47
  48 andM, orM :: (Monad m) => m [Bool] -> m Bool
  49 andM = Monad.liftM and
  50 orM = Monad.liftM or
  51
  52 -- | Monadic versions of any and all. We reimplement them, since there
  53 -- is no ready-made lifting function for them.
  54 allM, anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
  55 allM f = andM . (mapM f)
  56 anyM f = orM . (mapM f)
  57
  58 mapAccumLM :: (Monad m) => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
  59 mapAccumLM _ s []        =  return (s, [])
  60 mapAccumLM f s (x:xs)    =  do
  61   (s',  y ) <- f s x
  62   (s'', ys) <- mapAccumLM f s' xs
  63   return (s'', y:ys)
  64
  65 -- Trace the given string if the given bool is True, do nothing
  66 -- otherwise.
  67 traceIf :: Bool -> String -> a -> a
  68 traceIf True = Trace.trace
  69 traceIf False = flip const