X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FUtils%2FGhcTools.hs;h=c407436e61939553832e4b5fb66e5162edb8e892;hb=eade653c03372e3cc27e502e053b6de7d924eb64;hp=fc63ac4e9560079185caaa13bba32df694f88d61;hpb=f3951a1376fc7d7f8addbe9e9fed071320502100;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Utils/GhcTools.hs" "b/c\316\273ash/CLasH/Utils/GhcTools.hs" index fc63ac4..c407436 100644 --- "a/c\316\273ash/CLasH/Utils/GhcTools.hs" +++ "b/c\316\273ash/CLasH/Utils/GhcTools.hs" @@ -19,6 +19,7 @@ import qualified Name import qualified Serialized import qualified Var import qualified Outputable +import qualified Class -- Local Imports import CLasH.Utils.Pretty @@ -31,11 +32,14 @@ listBindings libdir filenames = do (cores,_,_) <- loadModules libdir filenames Nothing let binds = concatMap (CoreSyn.flattenBinds . HscTypes.cm_binds) cores mapM listBinding binds + putStr "\n=========================\n" + let classes = concatMap (HscTypes.typeEnvClasses . HscTypes.cm_types) cores + mapM listClass classes listBinding :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> IO () listBinding (b, e) = do putStr "\nBinder: " - putStr $ show b + putStr $ show b ++ "[" ++ show (Var.varUnique b) ++ "]" putStr "\nType of Binder: \n" putStr $ Outputable.showSDoc $ Outputable.ppr $ Var.varType b putStr "\n\nExpression: \n" @@ -45,6 +49,14 @@ listBinding (b, e) = do putStr "\n\nType of Expression: \n" putStr $ Outputable.showSDoc $ Outputable.ppr $ CoreUtils.exprType e putStr "\n\n" + +listClass :: Class.Class -> IO () +listClass c = do + putStr "\nClass: " + putStr $ show (Class.className c) + putStr "\nSelectors: " + putStr $ show (Class.classSelIds c) + putStr "\n" -- | Show the core structure of the given binds in the given file. listBind :: FilePath -> [FilePath] -> String -> IO ()