update cabal file to upload to hackage

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

diff --git a/cλash/CLasH/Utils/Core/CoreShow.hs b/cλash/CLasH/Utils/Core/CoreShow.hs
index 192ecc8ed2e6be50cd29bbb860e31d199b7b4e82..ca2a7fba193094a06c30fe9a337918d6b80d1a55 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreShow.hs
+++ b/cλash/CLasH/Utils/Core/CoreShow.hs
@@ -1,23 +1,21 @@
 {-# LANGUAGE StandaloneDeriving,FlexibleInstances, UndecidableInstances, OverlappingInstances #-}
-module CLasH.Utils.Core.CoreShow where
-
+--
 -- This module derives Show instances for CoreSyn types.
+--
+module CLasH.Utils.Core.CoreShow where
 
+-- GHC API
 import qualified BasicTypes
-
 import qualified CoreSyn
 import qualified TypeRep
 import qualified TyCon
-
 import qualified HsTypes
 import qualified HsExpr
 import qualified HsBinds
 import qualified SrcLoc
 import qualified RdrName
-
 import Outputable ( Outputable, OutputableBndr, showSDoc, ppr)
 
-
 -- Derive Show for core expressions and binders, so we can see the actual
 -- structure.
 deriving instance (Show b) => Show (CoreSyn.Expr b)
@@ -27,18 +25,39 @@ deriving instance (Show n, OutputableBndr n) => Show (HsTypes.HsType n)
 deriving instance (Show n, OutputableBndr n) => Show (HsTypes.ConDeclField n)
 deriving instance (Show x) => Show (SrcLoc.Located x)
 deriving instance (Show x, OutputableBndr x) => Show (HsExpr.StmtLR x x)
+deriving instance (Show x, OutputableBndr x) => Show (HsExpr.HsTupArg x)
 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
 -- as well.
 instance Show TypeRep.PredType where
-  show t = "_PredType:(" ++ (showSDoc $ ppr t) ++ ")"
+  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
@@ -58,4 +77,4 @@ instance Show (HsExpr.GRHSs id) where
 
 
 instance (Outputable x) => Show x where
-  show x = "__" ++  (showSDoc $ ppr x) ++ "__"
+  show x = "__" ++ showSDoc (ppr x) ++ "__"