Utils.hs

   1 module CLasH.Utils
   2   ( listBindings
   3   , listBind
   4   ) where
   5
   6 -- Standard Imports
   7 import qualified Maybe
   8
   9 -- GHC API
  10 import qualified CoreSyn
  11 import qualified CoreUtils
  12 import qualified HscTypes
  13 import qualified Outputable
  14 import qualified Var
  15
  16 -- Local Imports
  17 import CLasH.Utils.GhcTools
  18 import CLasH.Utils.Pretty
  19
  20 listBindings :: FilePath -> [FilePath] -> IO [()]
  21 listBindings libdir filenames = do
  22   (cores,_,_,_,_) <- loadModules libdir filenames bogusFinder bogusFinder bogusFinder
  23   let binds = concat $ map (CoreSyn.flattenBinds . HscTypes.cm_binds) cores
  24   mapM (listBinding) binds
  25     where
  26       bogusFinder = (\x -> return $ Nothing)
  27
  28 listBinding :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> IO ()
  29 listBinding (b, e) = do
  30   putStr "\nBinder: "
  31   putStr $ show b
  32   putStr "\nType of Binder: \n"
  33   putStr $ Outputable.showSDoc $ Outputable.ppr $ Var.varType b
  34   putStr "\n\nExpression: \n"
  35   putStr $ prettyShow e
  36   putStr "\n\n"
  37   putStr $ Outputable.showSDoc $ Outputable.ppr e
  38   putStr "\n\nType of Expression: \n"
  39   putStr $ Outputable.showSDoc $ Outputable.ppr $ CoreUtils.exprType e
  40   putStr "\n\n"
  41
  42 -- | Show the core structure of the given binds in the given file.
  43 listBind :: FilePath -> [FilePath] -> String -> IO ()
  44 listBind libdir filenames name = do
  45   (_,corebind,_,coreexpr,_) <- loadModules libdir filenames bindFinder bindFinder exprFinder
  46   listBinding (Maybe.fromJust $ head corebind, Maybe.fromJust $ head coreexpr)
  47     where
  48       bindFinder  = findBind (hasVarName name)
  49       exprFinder  = findExpr (hasVarName name)