X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FUtils.hs;h=484fe15ae2e33d43e3dd4b9bfee6fa4ee30117b1;hb=adf357ab8731531dfea0a21254cfc613031e083a;hp=705a46603b42f3f4e4ab16dbbffecae7cd512dd2;hpb=fcadaad2e47e5f6cba4b9f7d4341477b8fe74158;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Utils.hs" "b/c\316\273ash/CLasH/Utils.hs" index 705a466..484fe15 100644 --- "a/c\316\273ash/CLasH/Utils.hs" +++ "b/c\316\273ash/CLasH/Utils.hs" @@ -1,57 +1,16 @@ -module CLasH.Utils - ( listBindings - , listBind - , makeCached - ) where +module CLasH.Utils where -- Standard Imports import qualified Maybe import Data.Accessor import qualified Data.Map as Map +import qualified Control.Monad as Monad import qualified Control.Monad.Trans.State as State -- GHC API -import qualified CoreSyn -import qualified CoreUtils -import qualified HscTypes -import qualified Outputable -import qualified Var -- Local Imports -import CLasH.Utils.GhcTools -import CLasH.Utils.Pretty -listBindings :: FilePath -> [FilePath] -> IO [()] -listBindings libdir filenames = do - (cores,_,_,_,_) <- loadModules libdir filenames bogusFinder bogusFinder bogusFinder - let binds = concat $ map (CoreSyn.flattenBinds . HscTypes.cm_binds) cores - mapM (listBinding) binds - where - bogusFinder = (\x -> return $ Nothing) - -listBinding :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> IO () -listBinding (b, e) = do - putStr "\nBinder: " - putStr $ show b - putStr "\nType of Binder: \n" - putStr $ Outputable.showSDoc $ Outputable.ppr $ Var.varType b - putStr "\n\nExpression: \n" - putStr $ prettyShow e - putStr "\n\n" - putStr $ Outputable.showSDoc $ Outputable.ppr e - putStr "\n\nType of Expression: \n" - putStr $ Outputable.showSDoc $ Outputable.ppr $ CoreUtils.exprType e - putStr "\n\n" - --- | Show the core structure of the given binds in the given file. -listBind :: FilePath -> [FilePath] -> String -> IO () -listBind libdir filenames name = do - (_,corebind,_,coreexpr,_) <- loadModules libdir filenames bindFinder bindFinder exprFinder - listBinding (Maybe.fromJust $ head corebind, Maybe.fromJust $ head coreexpr) - where - bindFinder = findBind (hasVarName name) - exprFinder = findExpr (hasVarName name) - -- Make a caching version of a stateful computatation. makeCached :: (Monad m, Ord k) => k -- ^ The key to use for the cache @@ -69,3 +28,19 @@ makeCached key accessor create = do value <- create modA accessor (Map.insert key value) return value + +unzipM :: (Monad m) => + m [(a, b)] + -> m ([a], [b]) +unzipM = Monad.liftM unzip + +catMaybesM :: (Monad m) => + m [Maybe a] + -> m [a] +catMaybesM = Monad.liftM Maybe.catMaybes + +concatM :: (Monad m) => + m [[a]] + -> m [a] +concatM = Monad.liftM concat +