ca2a7fba193094a06c30fe9a337918d6b80d1a55
[matthijs/master-project/cλash.git] / 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) ++ "__"