From: Matthijs Kooijman Date: Fri, 31 Jul 2009 09:26:59 +0000 (+0200) Subject: Merge branch 'master' of git://github.com/christiaanb/clash into cλash X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=4b87be0b9d499155084a6240b016afd57b4b30cd;hp=04de89474351850ea9dca0350fa383f1b2aff8ea;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Merge branch 'master' of git://github.com/christiaanb/clash into cλash * 'master' of git://github.com/christiaanb/clash: Quick hack implementation of FSVec literals, needs to be fixed We need the latest vhdl package We now make a show function for all default datatypes. Add automated testbench generation according to supplied test input Conflicts: cλash/CLasH/Translator.hs --- diff --git "a/c\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs" index c35e338..a347143 100644 --- "a/c\316\273ash/CLasH/Translator.hs" +++ "b/c\316\273ash/CLasH/Translator.hs" @@ -91,11 +91,13 @@ listBinding :: (CoreBndr, CoreExpr) -> IO () listBinding (b, e) = do putStr "\nBinder: " putStr $ show b - putStr "\nExpression: \n" + putStr "\nType of Binder: \n" + putStr $ showSDoc $ ppr $ Var.varType b + putStr "\n\nExpression: \n" putStr $ prettyShow e putStr "\n\n" putStr $ showSDoc $ ppr e - putStr "\n\n" + putStr "\n\nType of Expression: \n" putStr $ showSDoc $ ppr $ CoreUtils.exprType e putStr "\n\n" @@ -104,13 +106,7 @@ listBind :: FilePath -> String -> String -> IO () listBind libdir filename name = do (core, env) <- loadModule libdir filename let [(b, expr)] = findBinds core [name] - putStr "\n" - putStr $ prettyShow expr - putStr "\n\n" - putStr $ showSDoc $ ppr expr - putStr "\n\n" - putStr $ showSDoc $ ppr $ CoreUtils.exprType expr - putStr "\n\n" + listBinding (b, expr) -- | Translate the binds with the given names from the given core module to -- VHDL. The Bool in the tuple makes the function stateful (True) or diff --git "a/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" "b/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" index ac6b1d1..1db286e 100644 --- "a/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" +++ "b/c\316\273ash/CLasH/Utils/Core/CoreShow.hs" @@ -32,6 +32,7 @@ deriving instance (Show x, OutputableBndr x) => Show (HsExpr.HsExpr x) deriving instance Show (RdrName.RdrName) deriving instance (Show idL, Show idR, OutputableBndr idL, OutputableBndr idR) => Show (HsBinds.HsBindLR idL idR) deriving instance Show CoreSyn.Note +deriving instance Show TyCon.SynTyConRhs -- Implement dummy shows, since deriving them will need loads of other shows @@ -39,7 +40,26 @@ deriving instance Show CoreSyn.Note instance Show TypeRep.PredType where show t = "_PredType:(" ++ (showSDoc $ ppr t) ++ ")" instance Show TyCon.TyCon where - show t = "_TyCon:(" ++ (showSDoc $ ppr t) ++ ")" + show t | TyCon.isAlgTyCon t && not (TyCon.isTupleTyCon t) = + showtc "AlgTyCon" "" + | TyCon.isCoercionTyCon t = + showtc "CoercionTyCon" "" + | TyCon.isSynTyCon t = + showtc "SynTyCon" (", synTcRhs = " ++ synrhs) + | TyCon.isTupleTyCon t = + showtc "TupleTyCon" "" + | TyCon.isFunTyCon t = + showtc "FunTyCon" "" + | TyCon.isPrimTyCon t = + showtc "PrimTyCon" "" + | TyCon.isSuperKindTyCon t = + showtc "SuperKindTyCon" "" + | otherwise = + "_Nonexistant tycon?:(" ++ (showSDoc $ ppr t) ++ ")_" + where + showtc con extra = "(" ++ con ++ " {tyConName = " ++ name ++ extra ++ ", ...})" + name = show (TyCon.tyConName t) + synrhs = show (TyCon.synTyConRhs t) instance Show BasicTypes.Boxity where show b = "_Boxity" instance Show HsTypes.HsExplicitForAll where