cλash/CLasH/Utils.hs

   1 module CLasH.Utils
   2   ( listBindings
   3   , listBind
   4   , makeCached
   5   ) where
   6
   7 -- Standard Imports
   8 import qualified Maybe
   9 import Data.Accessor
  10 import qualified Data.Map as Map
  11 import qualified Control.Monad.Trans.State as State
  12
  13 -- GHC API
  14 import qualified CoreSyn
  15 import qualified CoreUtils
  16 import qualified HscTypes
  17 import qualified Outputable
  18 import qualified Var
  19
  20 -- Local Imports
  21 import CLasH.Utils.GhcTools
  22 import CLasH.Utils.Pretty
  23
  24 listBindings :: FilePath -> [FilePath] -> IO [()]
  25 listBindings libdir filenames = do
  26   (cores,_,_,_,_) <- loadModules libdir filenames bogusFinder bogusFinder bogusFinder
  27   let binds = concat $ map (CoreSyn.flattenBinds . HscTypes.cm_binds) cores
  28   mapM (listBinding) binds
  29     where
  30       bogusFinder = (\x -> return $ Nothing)
  31
  32 listBinding :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> IO ()
  33 listBinding (b, e) = do
  34   putStr "\nBinder: "
  35   putStr $ show b
  36   putStr "\nType of Binder: \n"
  37   putStr $ Outputable.showSDoc $ Outputable.ppr $ Var.varType b
  38   putStr "\n\nExpression: \n"
  39   putStr $ prettyShow e
  40   putStr "\n\n"
  41   putStr $ Outputable.showSDoc $ Outputable.ppr e
  42   putStr "\n\nType of Expression: \n"
  43   putStr $ Outputable.showSDoc $ Outputable.ppr $ CoreUtils.exprType e
  44   putStr "\n\n"
  45
  46 -- | Show the core structure of the given binds in the given file.
  47 listBind :: FilePath -> [FilePath] -> String -> IO ()
  48 listBind libdir filenames name = do
  49   (_,corebind,_,coreexpr,_) <- loadModules libdir filenames bindFinder bindFinder exprFinder
  50   listBinding (Maybe.fromJust $ head corebind, Maybe.fromJust $ head coreexpr)
  51     where
  52       bindFinder  = findBind (hasVarName name)
  53       exprFinder  = findExpr (hasVarName name)
  54
  55 -- Make a caching version of a stateful computatation.
  56 makeCached :: (Monad m, Ord k) =>
  57   k -- ^ The key to use for the cache
  58   -> Accessor s (Map.Map k v) -- ^ The accessor to get at the cache
  59   -> State.StateT s m v -- ^ How to compute the value to cache?
  60   -> State.StateT s m v -- ^ The resulting value, from the cache or freshly
  61                         --   computed.
  62 makeCached key accessor create = do
  63   cache <- getA accessor
  64   case Map.lookup key cache of
  65     -- Found in cache, just return
  66     Just value -> return value
  67     -- Not found, compute it and put it in the cache
  68     Nothing -> do
  69       value <- create
  70       modA accessor (Map.insert key value)
  71       return value