Bring back listBind(ings) in Utils.hs by reorganising Translator.hs and GhcTools.hs

[matthijs/master-project/cλash.git] / cλash / CLasH / Utils.hs

diff --git a/cλash/CLasH/Utils.hs b/cλash/CLasH/Utils.hs
new file mode 100644 (file)
index 0000000..c539c79
--- /dev/null
+++ b/cλash/CLasH/Utils.hs
@@ -0,0 +1,49 @@
+module CLasH.Utils
+  ( listBindings
+  , listBind
+  ) where
+
+-- Standard Imports
+import qualified Maybe
+
+-- 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)
\ No newline at end of file