cλash/CLasH/Utils/Core/CoreShow.hs

   1 {-# LANGUAGE StandaloneDeriving,FlexibleInstances, UndecidableInstances, OverlappingInstances #-}
   2 module CLasH.Utils.Core.CoreShow where
   3
   4 -- This module derives Show instances for CoreSyn types.
   5
   6 import qualified BasicTypes
   7
   8 import qualified CoreSyn
   9 import qualified TypeRep
  10 import qualified TyCon
  11
  12 import qualified HsTypes
  13 import qualified HsExpr
  14 import qualified HsBinds
  15 import qualified SrcLoc
  16 import qualified RdrName
  17
  18 import Outputable ( Outputable, OutputableBndr, showSDoc, ppr)
  19
  20
  21 -- Derive Show for core expressions and binders, so we can see the actual
  22 -- structure.
  23 deriving instance (Show b) => Show (CoreSyn.Expr b)
  24 deriving instance (Show b) => Show (CoreSyn.Bind b)
  25 deriving instance Show TypeRep.Type
  26 deriving instance (Show n, OutputableBndr n) => Show (HsTypes.HsType n)
  27 deriving instance (Show n, OutputableBndr n) => Show (HsTypes.ConDeclField n)
  28 deriving instance (Show x) => Show (SrcLoc.Located x)
  29 deriving instance (Show x, OutputableBndr x) => Show (HsExpr.StmtLR x x)
  30 deriving instance (Show x, OutputableBndr x) => Show (HsExpr.HsTupArg x)
  31 deriving instance (Show x, OutputableBndr x) => Show (HsExpr.HsExpr x)
  32 deriving instance Show (RdrName.RdrName)
  33 deriving instance (Show idL, Show idR, OutputableBndr idL, OutputableBndr idR) => Show (HsBinds.HsBindLR idL idR)
  34 deriving instance Show CoreSyn.Note
  35 deriving instance Show TyCon.SynTyConRhs
  36
  37
  38 -- Implement dummy shows, since deriving them will need loads of other shows
  39 -- as well.
  40 instance Show TypeRep.PredType where
  41   show t = "_PredType:(" ++ (showSDoc $ ppr t) ++ ")"
  42 instance Show TyCon.TyCon where
  43   show t | TyCon.isAlgTyCon t && not (TyCon.isTupleTyCon t) =
  44            showtc "AlgTyCon" ""
  45          | TyCon.isCoercionTyCon t =
  46            showtc "CoercionTyCon" ""
  47          | TyCon.isSynTyCon t =
  48            showtc "SynTyCon" (", synTcRhs = " ++ synrhs)
  49          | TyCon.isTupleTyCon t =
  50            showtc "TupleTyCon" ""
  51          | TyCon.isFunTyCon t =
  52            showtc "FunTyCon" ""
  53          | TyCon.isPrimTyCon t =
  54            showtc "PrimTyCon" ""
  55          | TyCon.isSuperKindTyCon t =
  56            showtc "SuperKindTyCon" ""
  57          | otherwise =
  58            "_Nonexistant tycon?:(" ++ (showSDoc $ ppr t) ++ ")_"
  59       where
  60         showtc con extra = "(" ++ con ++ " {tyConName = " ++ name ++ extra ++ ", ...})"
  61         name = show (TyCon.tyConName t)
  62         synrhs = show (TyCon.synTyConRhs t)
  63 instance Show BasicTypes.Boxity where
  64   show b = "_Boxity"
  65 instance Show HsTypes.HsExplicitForAll where
  66   show b = "_HsExplicitForAll"
  67 instance Show HsExpr.HsArrAppType where
  68   show b = "_HsArrAppType"
  69 instance Show (HsExpr.MatchGroup x) where
  70   show b = "_HsMatchGroup"
  71 instance Show (HsExpr.GroupByClause x) where
  72   show b = "_GroupByClause"
  73 instance Show (HsExpr.HsStmtContext x) where
  74   show b = "_HsStmtContext"
  75 instance Show (HsBinds.Prag) where
  76   show b = "_Prag"
  77 instance Show (HsExpr.GRHSs id) where
  78   show b = "_GRHSs"
  79
  80
  81 instance (Outputable x) => Show x where
  82   show x = "__" ++  (showSDoc $ ppr x) ++ "__"