Actually make the scrutinee binder removal not crash.
[matthijs/master-project/cλash.git] / cλash / CLasH / Utils / Pretty.hs
1 module CLasH.Utils.Pretty (prettyShow, pprString, pprStringDebug) where
2
3
4 import qualified Data.Map as Map
5 import qualified Data.Foldable as Foldable
6 import qualified List
7
8 import qualified CoreSyn
9 import qualified Module
10 import qualified HscTypes
11 import Text.PrettyPrint.HughesPJClass
12 import Outputable ( showSDoc, showSDocDebug, ppr, Outputable, OutputableBndr)
13
14 import qualified Language.VHDL.Ppr as Ppr
15 import qualified Language.VHDL.AST as AST
16 import qualified Language.VHDL.AST.Ppr
17
18 import CLasH.Translator.TranslatorTypes
19 import CLasH.VHDL.VHDLTypes
20 import CLasH.Utils.Core.CoreShow
21
22 -- | A version of the default pPrintList method, which uses a custom function
23 --   f instead of pPrint to print elements.
24 printList :: (a -> Doc) -> [a] -> Doc
25 printList f = brackets . fsep . punctuate comma . map f
26
27 {-
28 instance Pretty FuncData where
29   pPrint (FuncData flatfunc entity arch) =
30     text "Flattened: " $$ nest 15 (ppffunc flatfunc)
31     $+$ text "Entity" $$ nest 15 (ppent entity)
32     $+$ pparch arch
33     where
34       ppffunc (Just f) = pPrint f
35       ppffunc Nothing  = text "Nothing"
36       ppent (Just e)   = pPrint e
37       ppent Nothing    = text "Nothing"
38       pparch Nothing = text "VHDL architecture not present"
39       pparch (Just _) = text "VHDL architecture present"
40 -}
41
42 instance Pretty Entity where
43   pPrint (Entity id args res decl) =
44     text "Entity: " $$ nest 10 (pPrint id)
45     $+$ text "Args: " $$ nest 10 (pPrint args)
46     $+$ text "Result: " $$ nest 10 (pPrint res)
47     $+$ text "Declaration not shown"
48
49 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where
50   pPrint (CoreSyn.NonRec b expr) =
51     text "NonRec: " $$ nest 10 (prettyBind (b, expr))
52   pPrint (CoreSyn.Rec binds) =
53     text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
54
55 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Expr b) where
56   pPrint = text . show
57
58 instance Pretty AST.VHDLId where
59   pPrint id = Ppr.ppr id
60   
61 instance Pretty AST.VHDLName where
62   pPrint name = Ppr.ppr name
63
64 prettyBind :: (Show b, Show e) => (b, e) -> Doc
65 prettyBind (b, expr) =
66   text b' <> text " = " <> text expr'
67   where
68     b' = show b
69     expr' = show expr
70
71 instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
72   pPrint = 
73     vcat . map ppentry . Map.toList
74     where
75       ppentry (k, v) =
76         pPrint k <> text " : " $$ nest 15 (pPrint v)
77
78 -- Convenience method for turning an Outputable into a string
79 pprString :: (Outputable x) => x -> String
80 pprString = showSDoc . ppr
81
82 pprStringDebug :: (Outputable x) => x -> String
83 pprStringDebug = showSDocDebug . ppr