Bring back listBind(ings) in Utils.hs by reorganising Translator.hs and GhcTools.hs
[matthijs/master-project/cλash.git] / 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) ++ "__"