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

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