{-# 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)
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
instance (Outputable x) => Show x where
- show x = "__" ++ (showSDoc $ ppr x) ++ "__"
+ show x = "__" ++ showSDoc (ppr x) ++ "__"