1 module CLasH.Utils where
6 import qualified Data.Map as Map
7 import qualified Control.Monad as Monad
8 import qualified Control.Monad.Trans.State as State
11 import qualified CoreSyn
12 import qualified CoreUtils
13 import qualified HscTypes
14 import qualified Outputable
18 import CLasH.Utils.GhcTools
19 import CLasH.Utils.Pretty
21 listBindings :: FilePath -> [FilePath] -> IO [()]
22 listBindings libdir filenames = do
23 (cores,_,_,_,_) <- loadModules libdir filenames bogusFinder bogusFinder bogusFinder
24 let binds = concat $ map (CoreSyn.flattenBinds . HscTypes.cm_binds) cores
25 mapM (listBinding) binds
27 bogusFinder = (\x -> return $ Nothing)
29 listBinding :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> IO ()
30 listBinding (b, e) = do
33 putStr "\nType of Binder: \n"
34 putStr $ Outputable.showSDoc $ Outputable.ppr $ Var.varType b
35 putStr "\n\nExpression: \n"
38 putStr $ Outputable.showSDoc $ Outputable.ppr e
39 putStr "\n\nType of Expression: \n"
40 putStr $ Outputable.showSDoc $ Outputable.ppr $ CoreUtils.exprType e
43 -- | Show the core structure of the given binds in the given file.
44 listBind :: FilePath -> [FilePath] -> String -> IO ()
45 listBind libdir filenames name = do
46 (_,corebind,_,coreexpr,_) <- loadModules libdir filenames bindFinder bindFinder exprFinder
47 listBinding (Maybe.fromJust $ head corebind, Maybe.fromJust $ head coreexpr)
49 bindFinder = findBind (hasVarName name)
50 exprFinder = findExpr (hasVarName name)
52 -- Make a caching version of a stateful computatation.
53 makeCached :: (Monad m, Ord k) =>
54 k -- ^ The key to use for the cache
55 -> Accessor s (Map.Map k v) -- ^ The accessor to get at the cache
56 -> State.StateT s m v -- ^ How to compute the value to cache?
57 -> State.StateT s m v -- ^ The resulting value, from the cache or freshly
59 makeCached key accessor create = do
60 cache <- getA accessor
61 case Map.lookup key cache of
62 -- Found in cache, just return
63 Just value -> return value
64 -- Not found, compute it and put it in the cache
67 modA accessor (Map.insert key value)
70 unzipM :: (Monad m) =>
73 unzipM = Monad.liftM unzip
75 catMaybesM :: (Monad m) =>
78 catMaybesM = Monad.liftM Maybe.catMaybes
80 concatM :: (Monad m) =>
83 concatM = Monad.liftM concat