From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
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